Нужно написать макрос который при выборе покупателя будет выделять в прайсе его цены.  
P.S. От Вас пример ждут. Правила почитайте.

Т.е. это лотерея такая - при нажатии на покупателя в прайсе цветом случайным образом выделяются его цены? :)

Хорошо.  
Поместите код в модуль листа:  
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)  
Dim k1, k2, k3, arr, a  
 
   k1 = Split("1 3")  
   k2 = Split("3 1")  
   k3 = Split("2 1")  
     
   Select Case Target.Address  
   Case "$J$5": a = k1  
   Case "$J$6": a = k2  
   Case "$J$7": a = k3  
   Case Else: Exit Sub  
   End Select  
     
   arr = Split("d3:f11 d13:f23")  
 
   For i = 0 To UBound(arr)  
       Range(arr(i)).Interior.ColorIndex = xlNone  
       Range(arr(i)).Columns(Val(a(i))).Interior.Color = vbRed  
   Next  
 
End Sub  
 
 
Как видите, нужно "расширить и углубить"

Чуть упростил, но "углубил":  
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)  
   Dim arr, a  
 
   Select Case Target.Address  
   Case "$J$5": a = Split("1 3 2")    'столбцы первого клиента  
   Case "$J$6": a = Split("3 1 1")    'аналогично второго  
   Case "$J$7": a = Split("2 1 3")    'третьего  
   Case Else: Exit Sub  
   End Select  
 
   arr = Split("d3:f11 d13:f23 d25:f52")  
 
   For i = 0 To UBound(arr)  
       Range(arr(i)).Interior.ColorIndex = xlNone  
       Range(arr(i)).Columns(Val(a(i))).Interior.Color = vbRed  
   Next  
 
End Sub

Да, вместо vbRed пишите vbMagenta - это Ваш цвет :)  
Или запишите рекордером присвоение нужного цвета и используйте в коде, например:  
Range(arr(i)).Columns(Val(a(i))).Interior.ColorIndex = 42

Файлик с цветами когда-то выкладывал тут (если рекордер мучить неохота):  
<EM>http://www.sql.ru/forum/actualfile.aspx?id=7991350</EM>  
 
А чтоб очищать - такая редакция кода:  
1. добавил очистку в Select case по адресу "$J$8"  
2. перенёс наполнение arr в начало кода, чтоб очистка работала.  
Можете легко скорректировать свой код.  
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)  
   Dim arr, a  
   arr = Split("d3:f11 d13:f23 d25:f52")  
 
   Select Case Target.Address  
   Case "$J$5": a = Split("1 3 2")    'столбцы первого клиента  
   Case "$J$6": a = Split("3 1 1")    'аналогично второго  
   Case "$J$7": a = Split("2 1 3")    'третьего  
   Case "$J$8"  
       For i = 0 To UBound(arr): Range(arr(i)).Interior.ColorIndex = xlNone: Next  
       Exit Sub  
   Case Else: Exit Sub  
   End Select  
 
   For i = 0 To UBound(arr)  
       Range(arr(i)).Interior.ColorIndex = xlNone  
       Range(arr(i)).Columns(Val(a(i))).Interior.Color = vbMagenta  
   Next  
 
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)  
Dim arr, a  
arr = Split("D7:K15 D17:K27 D29:K36 D38:K47 D49:K56 D58:K68 D70:K71 D73:K77 D79:K88 D90:K97 D99:K110 D112:K139 D141:K154 D156:K165 D167:K173 D175:K180 D182:K193 D195:K201 D203:K207 D209:K214 D216:K216 D218:K220 D222:K230 D232:K238 D240:K243 D245:K249 D251:K255 D257:K263 D265:K273")  
 
Select Case Target.Address  
Case "$M$4": a = Split("1 3 2 3 1 3 2 3 1 3 2 3 1 3 2 3 1 3 2 3 1 3 2 3 1 3 2 3 1") 'столбцы первого клиента  
Case "$N$4": a = Split("2 2 3 1 3 2 1 2 3 2 3 1 3 2 3 1 3 2 3 1 3 2 3 1 3 2 3 1 1") 'аналогично второго  
Case "$O$4": a = Split("3 1 1 3 2 3 2 1 2 3 2 3 1 3 2 3 1 3 2 3 1 3 2 3 1 3 2 3 1") 'третьего  
Case "$P$4"  
For i = 0 To UBound(arr): Range(arr(i)).Interior.ColorIndex = xlNone: Next  
Exit Sub  
Case Else: Exit Sub  
End Select  
 
For i = 0 To UBound(arr)  
Range(arr(i)).Interior.ColorIndex = xlNone  
Range(arr(i)).Columns(Val(a(i))).Interior.Color = vbMagenta  
Next  
 
End Sub  
 
ОГРОМНОЕ спасибо! Вот что получилось, все работает. А как нибудь можно сделать так чтобы при вставке в прайс какой нибудь позиции не приходилось переписывать адреса всех блоков? Ps: думала про "ваш цвет" вы блондинку имели ввиду)))))

Вот утилитку написал, чтоб труд облегчить (имена для ПЕРВОГО листа!!!):  
 
Sub podmoga()  
Dim arr, i, s$  
arr = Split("D7:K15 D17:K27 D29:K36 D38:K47 D49:K56 D58:K68 D70:K71 D73:K77 D79:K88 D90:K97 D99:K110 D112:K139 D141:K154 D156:K165 D167:K173 D175:K180 D182:K193 D195:K201 D203:K207 D209:K214 D216:K216 D218:K220 D222:K230 D232:K238 D240:K243 D245:K249 D251:K255 D257:K263 D265:K273")  
For i = 0 To UBound(arr)  
Sheets(1).Range(arr(i)).Name = "diap" & i + 1  
s = s & "diap" & i + 1 & " "  
Next  
Debug.Print s  
End Sub  
 
А вот готовая строка для массива:  
'diap1 diap2 diap3 diap4 diap5 diap6 diap7 diap8 diap9 diap10 diap11 diap12 diap13 diap14 diap15 diap16 diap17 diap18 diap19 diap20 diap21 diap22 diap23 diap24 diap25 diap26 diap27 diap28 diap29  
 
Можно вместо diap писать покороче d_

Этот макрос на основе Ваших данных (массива arr) назначает имена этим диапазонам.  
Запускаете - получаете в книге 29 имён.  
Затем заменяете в своём макросе содержимое массива arr на полученную строку  
 
Лучше вероятно покороче так:  
 
Sub podmoga2()  
Dim arr, i, s$  
arr = Split("D7:K15 D17:K27 D29:K36 D38:K47 D49:K56 D58:K68 D70:K71 D73:K77 D79:K88 D90:K97 D99:K110 D112:K139 D141:K154 D156:K165 D167:K173 D175:K180 D182:K193 D195:K201 D203:K207 D209:K214 D216:K216 D218:K220 D222:K230 D232:K238 D240:K243 D245:K249 D251:K255 D257:K263 D265:K273")  
For i = 0 To UBound(arr)  
Range(arr(i)).Name = "d_" & i + 1  
s = s & "d_" & i + 1 & " "  
Next  
Debug.Print s  
End Sub  
 
и строка тогда (пробел в конце не копируем):  
d_1 d_2 d_3 d_4 d_5 d_6 d_7 d_8 d_9 d_10 d_11 d_12 d_13 d_14 d_15 d_16 d_17 d_18 d_19 d_20 d_21 d_22 d_23 d_24 d_25 d_26 d_27 d_28 d_29  
 
Теперь диапазоны можно двигать как угодно, добавлять строки внутрь, убирать.