Amy possible that i can create a simple VBA based of repetitive VBA

[loke2002249]

Hello, everyone..

i need some help to make this repetitive VBA into a very simple VBA

My repetitive VBA were shown as below

If Target.Address = "$L$6" Then
a = Sheets("Price Record").Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("Price Record").Range("A" & a).Value = Sheets("MasterItemPriceList").Range("M6").Value
End If


If Target.Address = "$L$6" Then
a = Sheets("Price Record").Cells(Rows.Count, "B").End(xlUp).Row + 1
Sheets("Price Record").Range("B" & a).Value = Sheets("MasterItemPriceList").Range("L6").Value
End If


If Target.Address = "$L$7" Then
a = Sheets("Price Record").Cells(Rows.Count, "C").End(xlUp).Row + 1
Sheets("Price Record").Range("C" & a).Value = Sheets("MasterItemPriceList").Range("M7").Value
End If


If Target.Address = "$L$7" Then
a = Sheets("Price Record").Cells(Rows.Count, "D").End(xlUp).Row + 1
Sheets("Price Record").Range("D" & a).Value = Sheets("MasterItemPriceList").Range("L7").Value
End If




If Target.Address = "$L$8" Then
a = Sheets("Price Record").Cells(Rows.Count, "E").End(xlUp).Row + 1
Sheets("Price Record").Range("E" & a).Value = Sheets("MasterItemPriceList").Range("M8").Value
End If


If Target.Address = "$L$8" Then
a = Sheets("Price Record").Cells(Rows.Count, "F").End(xlUp).Row + 1
Sheets("Price Record").Range("F" & a).Value = Sheets("MasterItemPriceList").Range("L8").Value
End If


If Target.Address = "$L$9" Then
a = Sheets("Price Record").Cells(Rows.Count, "G").End(xlUp).Row + 1
Sheets("Price Record").Range("G" & a).Value = Sheets("MasterItemPriceList").Range("M9").Value
End If


If Target.Address = "$L$9" Then
a = Sheets("Price Record").Cells(Rows.Count, "H").End(xlUp).Row + 1
Sheets("Price Record").Range("H" & a).Value = Sheets("MasterItemPriceList").Range("L9").Value
End If


If Target.Address = "$L$10" Then
a = Sheets("Price Record").Cells(Rows.Count, "I").End(xlUp).Row + 1
Sheets("Price Record").Range("I" & a).Value = Sheets("MasterItemPriceList").Range("M10").Value
End If


If Target.Address = "$L$10" Then
a = Sheets("Price Record").Cells(Rows.Count, "J").End(xlUp).Row + 1
Sheets("Price Record").Range("J" & a).Value = Sheets("MasterItemPriceList").Range("L10").Value
End If


and so on.....

 

[Fluff]

Hi & welcome to MrExcel.
Which sheet is that code in?

 

[loke2002249]

Hello,

the sheet name is MasterItemPriceList

 

[Fluff]

In that case how about

   Dim Clmn As Long

   If Not Intersect(Target, Range("L6:L10")) Is Nothing Then
      Clmn = Choose(Target.Row, , , , , , 1, 3, 5, 7, 9)
      With Sheets("Price Record").Cells(Rows.Count, Clmn).End(xlUp)
         .Offset(1).Value = Target.Offset(, 1).Value
         .Offset(1, 1).Value = Target.Value
      End With
   End If

 

[loke2002249]

Good morning, Thank you for your code because it actually work well

however as i know the excel totally have 16384 Column and i want to apply until the end of the column, is it possible ? because when i want to use this code by modify it until the end of the column (column 16384) , it seen cannot apply it properly.

If Not Intersect(Target, Range("L6:L480")) Is Nothing Then
Clmn = Choose(Target.Row, , , , , , 1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27, 29, 31, 33, 35, 37, 39, 41, 43, 45, 47, 49, 51, 53, 55, 57, 59, 61, 63, 65, 67, 69, 71, 73, 75, 77, 79, 81, 83, 85, 87, 89, 91, 93, 95, 97, 99, 101, 103, 105, 107, 109, 111, 113, 115, 117, 119, 121, 123, 125, 127, 129, 131, 133, 135, 137, 139, 141, 143, 145, 147, 149, 151, 153, 155, 157, 159, 161, 163, 165, 167, 169, 171, 173, 175, 177, 179, 181, 183, 185, 187, 189, 191, 193, 195, 197, 199, 201, 203, 205, 207, 209, 211, 213, 215, 217, 219, 221, 223, 225, 227, 229, 231, 233, 235, 237, 239, 241, 243, 245, 247, 249, 251, 253, 255, 257, 259, 261, 263, 265, 267, 269, 271, 273, 275, 277, 279, 281, 283, 285, 287, 289, 291, 293, 295, 297, 299, 301, 303, 305, 307, 309, 311, 313, 315, 317, 319, 321, 323, 325, 327, 329, 331, 333, 335, 337, 339, 341, 343, 345, 347, 349, 351, 353, 355, 357, 359, 361, 363, 365, 367, 369, 371, 373, 375, 377, 379, 381, 383, 385, 387, 389, 391, 393, 395, 397, 399, 401, 403, 405, 407, 409, 411, 413, 415, 417, 419, 421, 423, 425, 427, 429, 431, 433, 435, 437, 439, 441, 443, 445, 447, 449, 451, 453, 455, 457, 459, 461, 463, 465, 467, 469, 471, 473, 475, 477, 479, 481, 483, 485, 487, 489, 491, 493, 495, 497, 499, 501)
With Sheets("Price Record").Cells(Rows.Count, Clmn).End(xlUp)
.Offset(1).Value = Target.Offset(, 1).Value
.Offset(1, 1).Value = Target.Value
End With
End If



Until number column 501 , it already cannot work

 

[Fluff]

In that case try

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Clmn As Long
   If Not Intersect(Target, Range("L6:L480")) Is Nothing Then
      Clmn = 2 * Target.Row - 11
      If Clmn > 16383 Then Exit Sub
      With Sheets("Price Record").Cells(Rows.Count, Clmn).End(xlUp)
         .Offset(1).Value = Target.Offset(, 1).Value
         .Offset(1, 1).Value = Target.Value
      End With
   End If
End Sub

 

[loke2002249]

Dear,

Good morning... Thank you very much...

it totally solve my problem in the end....

 

[Fluff]

You're welcome & thanks for the feedback