cutting down this code? help?

cutting down this code? help?

• Bagles1

  Hello Milkshake,

  I think I followed the cell relationships and came up with this.

  I am writing to cells in the same sheet but you can just add the name of the sheet in front of the last two lines.

  ie Sheets("whatever").cells(etc etc....)=b1value.

  I only tested it for a few minutes so please let me know if is what you wanted.

  I actually place values in cells B1 and C1, you are probably getting them from your combobox.

  If this is not exactly right, I'm sure it will get you on your way.

  Sub Test()
  Dim B1Value As Integer
  Dim C1Value As Integer
  Dim B6Value
  Dim C6Value

  Dim RowOffset As Integer
  Dim colOffset As Integer

  B6Value = Range("B6").Value
  C6Value = Range("C6").Value

  B1Value = Cells(1, "B").Value
  C1Value = Cells(1, "C").Value

  RowOffset = 6
  colOffset = 2 * C1Value

  If C1Value > 1 Then
  colOffset = colOffset + C1Value - 1
  End If

  Cells(RowOffset + B1Value, colOffset) = B6Value ' add sheet name in front of line
  Cells(RowOffset + B1Value, colOffset + 1) = C6Value ' add sheetname in front of line

  End Sub
  

  
  

• Sourabh Khatri

  hello milkshake,

  Your right your code would be extremely lengthy. Here is a rework.... copy and paste this into a module

  The values stored in the cells (1, B and 1, C) are accessed using properties. There is a relationship between the value in 1, B and the row which is used to output. Output row appears to be 6 + the value of cell 1, B.

  if Cells(1, "B").Value = "1" then output = 7
  if Cells(1, "B").Value = "2" then output = 8
  if Cells(1, "B").Value = "3" then output = 9
  OutputRow = 6 + BCell Value, (i.e 6 + 1 = 7)

  The values in C are stored in a multi-dimensional array

  if Cells(1, "C").Value = "1" then output = B :C
  if Cells(1, "C").Value = "2" then output = E :F
  if Cells(1, "C").Value = "3" then output = H :I
  if Cells(1, "C").Value = "4" then output = K :L

  (1, B, C)

  (2, E, F)

  (3, H, I)

  The value of the cell 1, C is used to look up this array, for example is 1, C = 3 then (3, H, I) is used. All you will need to do is update the array to hold the columns for each value of C.

  The code uses this information to build the range which the values are pasted to.

  I know you have no experience so if you have any questions about the code just ask.

  'seven C values 1 to 7, with two column references i.e. B:C
  Dim CArray(7, 2) As String

  
  Public Sub Refactored()
  
  'create the array that maps the C value to the cell references
  'if C value = 1 then B and C
  CArray(1, 1) = "B"
  CArray(1, 2) = "C"
  'if C value = 2 then E and F
  CArray(2, 1) = "E"
  CArray(2, 2) = "F"
  'if C value = 3 then H and I
  CArray(3, 1) = "H"
  CArray(3, 2) = "I"
  'if C value = 4 then K and L
  CArray(4, 1) = "K"
  CArray(4, 2) = "L"
  'add to the array the other column references
  
  'the output row is 6 + the value stored in cell 1, "B"
  Dim OutputRow As Integer
  OutputRow = 6 + BValue
  
  'dynamically create the range which the output will be written to.
  Dim srngOutput As String
  srngOutput = CArray(CValue, 1) & OutputRow & ":" & CArray(CValue, 2) & OutputRow
  
  'do the copy and paste
  Range("B6:C6").Copy
  Sheets("Weeks").Range(srngOutput).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

  End Sub

  
  'these properties map to the B and C cells
  'best rename these to what the value in these cells actually are, i.e. day of week
  Public Property Get BValue() As Integer
  BValue = CInt(Cells(1, "B").Value)
  End Property

  Public Property Let BValue(ByVal vNewValue As Integer)
  Cells(1, "B").Value = vNewValue
  End Property

  Public Property Get CValue() As Integer
  CValue = CInt(Cells(1, "C").Value)
  End Property

  Public Property Let CValue(ByVal vNewValue As Integer)
  Cells(1, "C").Value = vNewValue
  End Property

  
  
  

• Smylie

  this actually worked perfect without any changes (apart from the sheet name)

  thank you so very much :)

  
  
  

• SPECIALK_BC

  Hi Milkshake

  The row that you paste to appears to be 6 + Cells(1, "B").Value this should cut your code down e.g.

  Dim myRow As String

  If Cells(1, "C").Value = "1" Then

  myRow=trim$(str$(val(Cells(1, "B").Value+6 )))
  Range("B6:C6").Copy
  Sheets("Weeks").Range("B" & myRow & ":C" & myRow ).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Else

  ...... etc
  

  
  
• cutting down this code? help?