Moving Data based off a condition

[ItalianPlatinum]

I am looking to modify my existing VBA to move data based off a cell's value. Currently I transfer assuming everything should go to the same destination column and copying over the dates. Little more simplistic (proved that code below)

But need to amend so the destination location may change based off the cell value.

For example if column F is ST then its respective amount and date go to its respective column. But if Column F is LT it goes to a different column F. Date 1 remains the same location of M. I use SPINV for other projects so i want to handle in VBA without adding helper columns.

'ST amount
With wsSPINV
    rws = .Range("G13:G13").End(xlDown).row - 1
    wsDIVN.Range("D2").Resize(rws, 1).Value = .Range("G13").Resize(rws).Value
End With

'Date 1
With wsSPINV
    rws = .Range("E13").End(xlDown).row - 1
    wsDIVN.Range("M2").Resize(rws).Value = .Range("E13").Resize(rws).Value
    wsDIVN.Range("M2").Resize(rws).TextToColumns Destination:=Range("M2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 5), TrailingMinusNumbers:=True
    wsDIVN.Range("M2").Resize(rws).NumberFormat = "mm/dd/yyyy"
        End With

This is SPINV

This is how it should look on my destination

 

[DanteAmor]

According to your macro, the data in the source sheet starts in row 14, I assume that the headers are in row 13.
The date is in column E but in the destination you want it in column M.
With those considerations, try the following code:

Sub moving_data()
  Dim wsSPINV As Worksheet, wsDIVN As Worksheet
  Dim a As Variant, b As Variant
  Dim i As Long, y As Long, nrow As Long, col As Long
  Dim dic As Object, ky As Variant
 
  Set wsSPINV = Sheets("SPINV")         'source
  Set wsDIVN = Sheets("DIVN")           'destination
  Set dic = CreateObject("Scripting.Dictionary")
 
  a = wsSPINV.Range("A14", wsSPINV.Range("G" & Rows.Count).End(3)).Value
  ReDim b(1 To UBound(a, 1), 1 To 12)   'from column B to M then 12 columns
 
  For i = 1 To UBound(a, 1)
    ky = a(i, 3) & "|" & a(i, 5)        'columns CL & Date1
    If Not dic.exists(ky) Then
      y = y + 1
      dic(ky) = y
    End If
    nrow = dic(ky)
    b(nrow, 1) = a(i, 4)    'T
    If a(i, 6) = "ST" Then col = 4 Else col = 6
    b(nrow, col) = a(i, 7)  'Rate
    b(nrow, 12) = a(i, 5)   'Date1
  Next
 
  wsDIVN.Range("B2").Resize(y, UBound(b, 2)).Value = b
End Sub

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

 

[ItalianPlatinum]

Thanks @DanteAmor - So I think a few tweaks may be needed. On the row start that is an error of mine and it starts on row 2. Row 1 is a header. So I adjusted this a = wsSPINV.Range("A14" to A2?

When playing the code it is putting the values on E and G not D and F. When testing it I noticed not all the data is transferring. See below what i mean.

Also, is it possible to transfer the other fields too? I know wishful thinking . ie Date 2, 3, and C.

 

[ItalianPlatinum]

Ok I made a few tweaks got all the data to populate. Odd the col 3 and col 5 dont match up?

'ST and LT
Set dic = CreateObject("Scripting.Dictionary")

  a = wsSPINV.Range("A2", wsSPINV.Range("G" & Rows.Count).End(3)).Value
  ReDim b(1 To UBound(a, 1), 1 To 17)   'from column B to R then 17 columns

  For i = 1 To UBound(a, 1)
    ky = a(i, 4) & "|" & a(i, 5)        'columns T & Date1
    If Not dic.exists(ky) Then
      y = y + 1
      dic(ky) = y
    End If
    nrow = dic(ky)
    b(nrow, 1) = a(i, 4)    'T
    If a(i, 6) = "ST" Then col = 3 Else col = 5
    b(nrow, col) = a(i, 7)  'Rate
    b(nrow, 12) = a(i, 5)   'Date1
  Next
 
  wsDSTN.Range("B2").Resize(y, UBound(b, 2)).Value = b

Then if anyway can also move over the other fields? also any blank value in ST or LT would be NA. I could set it all before i suppose as a way

 

[DanteAmor]

Then if anyway can also move over the other fields? also any blank value in ST or LT would be NA. I could set it all before i suppose as a way

I suppose there are other things that you haven't told me about.
For example:
In your new example the same T appears twice and with the same date and with the same Type, but with a different Rate, so what or how the result should be.

While trying the following, it includes the dates and the data is in the correct column.

Sub moving_data()
  Dim wsSPINV As Worksheet, wsDIVN As Worksheet
  Dim a As Variant, b As Variant
  Dim i As Long, y As Long, nrow As Long, col As Long
  Dim dic As Object, ky As Variant
  
  Set wsSPINV = Sheets("SPINV")         'source
  Set wsDIVN = Sheets("DIVN")           'destination
  Set dic = CreateObject("Scripting.Dictionary")
  
  a = wsSPINV.Range("A2", wsSPINV.Range("K" & Rows.Count).End(3)).Value
  ReDim b(1 To UBound(a, 1), 1 To 18)   'from column A to R then 18 columns
  
  For i = 1 To UBound(a, 1)
    ky = a(i, 4) & "|" & a(i, 5)        'columns T & Date1
    If Not dic.exists(ky) Then
      y = y + 1
      dic(ky) = y
    End If
    nrow = dic(ky)
    b(nrow, 2) = a(i, 4)    'T
    Select Case a(i, 6)
      Case "ST"
        b(nrow, 4) = a(i, 7)  'Rate
      Case "LT"
        b(nrow, 6) = a(i, 7)  'Rate
      Case Else
      
    End Select
    
    b(nrow, 13) = a(i, 5)   'Date1
    b(nrow, 11) = a(i, 8)   'Date2
    b(nrow, 12) = a(i, 9)   'Date3
    b(nrow, 18) = a(i, 11)  'C
  Next
  
  wsDIVN.Range("A2").Resize(y, UBound(b, 2)).Value = b
End Sub

 

[ItalianPlatinum]

Wow this is great. Looks to be working!

Now If i wanted to add NA for any ST or LT rate that is blank like this? Is that easy to add?

 

[DanteAmor]

Now If i wanted to add NA for any ST or LT rate that is blank like this?

Try:

Sub moving_data()
  Dim wsSPINV As Worksheet, wsDIVN As Worksheet
  Dim a As Variant, b As Variant
  Dim i As Long, y As Long, nrow As Long, col As Long
  Dim dic As Object, ky As Variant
  
  Set wsSPINV = Sheets("SPINV")         'source
  Set wsDIVN = Sheets("DIVN")           'destination
  Set dic = CreateObject("Scripting.Dictionary")
  
  a = wsSPINV.Range("A2", wsSPINV.Range("K" & Rows.Count).End(3)).Value
  ReDim b(1 To UBound(a, 1), 1 To 18)   'from column A to R then 18 columns
  
  For i = 1 To UBound(a, 1)
    ky = a(i, 4) & "|" & a(i, 5)        'columns T & Date1
    If Not dic.exists(ky) Then
      y = y + 1
      dic(ky) = y
    End If
    nrow = dic(ky)
    b(nrow, 2) = a(i, 4)    'T
    Select Case a(i, 6)
      Case "ST"
        b(nrow, 4) = a(i, 7)  'Rate
        If b(nrow, 6) = "" Then b(nrow, 6) = "NA"
      Case "LT"
        b(nrow, 6) = a(i, 7)  'Rate
        If b(nrow, 4) = "" Then b(nrow, 4) = "NA"
      Case Else
        If b(nrow, 4) = "" Then b(nrow, 4) = "NA"
        If b(nrow, 6) = "" Then b(nrow, 6) = "NA"
    End Select
    
    b(nrow, 13) = a(i, 5)   'Date1
    b(nrow, 11) = a(i, 8)   'Date2
    b(nrow, 12) = a(i, 9)   'Date3
    b(nrow, 18) = a(i, 11)  'C
  Next
  
  wsDIVN.Range("A2").Resize(y, UBound(b, 2)).Value = b
End Sub

 

[ItalianPlatinum]

Works beautifully. Thank you so much for the help on this. Enjoy your weekend Dante