How to Search for a value then populate a column if it matches?

[DMO123]

Hi, im hoping someone can help.

i have a data set that is continuously changing from the source and i need to keep a running total month by month. i am wondering if a VBA code could help.

my source is coming from "Tab1" A22 downwards and it can depend on how many rows down this always changes. what i am looking to do is to see if this value is in my other table on "Tab2" AT3 downwards and if it is to populate the value from "Tab1" in B22 (again can change as it moves down the list) in the relevant month which is in columns AU:BF (almost like a =Month(today()) type formula) so for example i have product 1 in my source and product 1 shows in my other table on tab2 and the month is May-2020 it needs to populate May2020 next to product 1.

if the value is not present it then needs to add it into Tab2 table in column AT and populate the value in tab1 B22 (again changes depending on the row) next to the relevant month.

so a full example would be:

Product 1 = in table on tab2 and populates May 2020 with the value in column B in tab1
Product 2 = not in table on tab 2 gets added to the list in AT and May 2020 is populated with the value from column B in Tab1

it would also need to paste the values as plan text.

i have tried a vlookup formula but because the source changes it doesn't work i must say i would attempt a VBA but i dont really no where to start when creating one!

any help is much appreciated!

 

[sijpie]

I don't understand the layout of Tab2 sheet.
In column AT you have a list of all the products (minus the new ones to be added), running from AT3 downwards
Are the months in columns B to M? something like below example?

	B	C	D	E	F	G	H	I	…	AT
2​
3​	year total	Jan 20	Feb 20	Mar 20	Apr 20	May 20	Jun 20	Jul 20		Product
4​		84,80​	61,07​	91,25​	56,90​	2,74​				ATP
5​		97,12​	44,47​	24,36​	55,64​	98,09​				XYZ
6​		99,02​	17,55​	42,55​	53,54​	50,92​				COD
7​						54,84​	value added			FTS	product added
8​
9​

 

[DMO123]

Yes thats correct - apologies if my explanation wasn't clear so it would look like the below. so when a new product is added lets say its called Product C and its not in the table currently it will drop in the next available line and add the value for Jun-20 as a start point

2	A	B	C	D	E	F	G
3	Product	Jan-20	Feb-20	Mar-20	Apr-20	May-20	Jun-20
4	Product A	22	34	56	67	21	23
5	Product B	45	32	12	34	34	45
6	Product C	0	0	0	0	0	40

 

[sijpie]

Try this code. Before you run it read through the comments. There are five places where the comments start with <<<<.
Here you may have to change something.

Option Explicit

Sub TransferProductInfo()
    Dim vInp As Variant, vOutp As Variant, vFill As Variant
    Dim lR1 As Long, lR2 As Long, lR3 As Long, lC2 As Long, UBo1 As Long, UBo2 As Long
    Dim wsInp As Worksheet, wsOutp As Worksheet
    Dim rIn As Range, rOut As Range
    Dim iMnth As Integer, sMnth As String
    
    Set wsInp = ThisWorkbook.Sheets("Tab1")  '<<<< modify sheet name as required
    Set wsOutp = ThisWorkbook.Sheets("Tab2") '<<<< modify sheet name as required
    
    Set rIn = wsInp.Range("A21")    '<<< Header row in input sheet (Tab1), modify as required
    Set rOut = wsOutp.Range("A3")   '<<< Header row in output sheet (Tab2), modify as required
    
    
    'load the input range into array for fast processing
    vInp = rIn.CurrentRegion.Value
    
    
    'load the output range into array. Use Transpose to enable adding rows if required _

    ' Add 1 row to add new month is required
    With rOut.CurrentRegion
        vOutp = .Resize(.Rows.Count, .Columns.Count + 1).Value
    End With
    
    vFill = Application.WorksheetFunction.Transpose(vOutp)
    
    'get size of output array
    UBo1 = UBound(vFill, 1)
    UBo2 = UBound(vFill, 2)
    
    iMnth = Month(Date)
    
    'check month with user
    Do
        sMnth = InputBox("Please enter month number for current product values", _
                    Title:="Check month", _
                    Default:=iMnth)
    Loop While Not IsNumeric(sMnth)
    
    iMnth = CInt(sMnth)
    
    'check if month in output array
    For lR2 = 2 To UBo1 - 1
        If Month(vFill(lR2, 1)) = iMnth Then Exit For
    Next lR2
    If lR2 = UBo1 Then
        'month not in output array yet, so add
        vFill(lR2, 1) = VBA.DateSerial(Year(Date), iMnth, 1)
    End If
    'lr2 now contains row where we need to add the product values
    
    ' the product names are held in row 1 of the output array
    'loop through the input array to get product name and value
    
    For lR1 = 2 To UBound(vInp, 1)      '<<<< if no header row in Tab1, change to lR1 = 1
        'find product in output array
        For lC2 = 2 To UBo2
            If vInp(lR1, 1) = vFill(1, lC2) Then Exit For
        Next lC2
        If lC2 > UBo2 Then  'product not found
            'make output array larger for new product
            ReDim Preserve vFill(1 To UBo1, 1 To UBo2 + 1)
            UBo2 = UBo2 + 1
            'put name in first row
            vFill(1, lC2) = vInp(lR1, 1)
            'enter 0 in the previous months
            For lR3 = 2 To lR2 - 1
                vFill(lR3, lC2) = 0
            Next lR3
        End If
        'add value for product in selected column for the month (held as lR2)
        vFill(lR2, lC2) = vInp(lR1, 2)
        
    Next lR1
    
'    'transpose the tFill array to the output array. The worksheet function does not work proerly with dates
    ReDim vOutp(1 To UBo2, 1 To UBo1)
    For lR2 = 1 To UBo2
        For lC2 = 1 To UBo1
            If lR2 = 1 And lC2 > 1 Then
                If Len(vFill(lC2, lR2)) Then
                    vOutp(lR2, lC2) = DateValue(vFill(lC2, lR2))
                End If
            Else
                vOutp(lR2, lC2) = vFill(lC2, lR2)
            End If
        Next lC2
    Next lR2
    'now dump vfill to the sheet
'    vOutp = WorksheetFunction.Transpose(vFill)
    rOut.Resize(UBo2, UBo1) = vOutp
    
End Sub

 

[DMO123]

Try this code. Before you run it read through the comments. There are five places where the comments start with <<<<.
Here you may have to change something.

Option Explicit

Sub TransferProductInfo()
    Dim vInp As Variant, vOutp As Variant, vFill As Variant
    Dim lR1 As Long, lR2 As Long, lR3 As Long, lC2 As Long, UBo1 As Long, UBo2 As Long
    Dim wsInp As Worksheet, wsOutp As Worksheet
    Dim rIn As Range, rOut As Range
    Dim iMnth As Integer, sMnth As String
   
    Set wsInp = ThisWorkbook.Sheets("Tab1")  '<<<< modify sheet name as required
    Set wsOutp = ThisWorkbook.Sheets("Tab2") '<<<< modify sheet name as required
   
    Set rIn = wsInp.Range("A21")    '<<< Header row in input sheet (Tab1), modify as required
    Set rOut = wsOutp.Range("A3")   '<<< Header row in output sheet (Tab2), modify as required
   
   
    'load the input range into array for fast processing
    vInp = rIn.CurrentRegion.Value
   
   
    'load the output range into array. Use Transpose to enable adding rows if required _

    ' Add 1 row to add new month is required
    With rOut.CurrentRegion
        vOutp = .Resize(.Rows.Count, .Columns.Count + 1).Value
    End With
   
    vFill = Application.WorksheetFunction.Transpose(vOutp)
   
    'get size of output array
    UBo1 = UBound(vFill, 1)
    UBo2 = UBound(vFill, 2)
   
    iMnth = Month(Date)
   
    'check month with user
    Do
        sMnth = InputBox("Please enter month number for current product values", _
                    Title:="Check month", _
                    Default:=iMnth)
    Loop While Not IsNumeric(sMnth)
   
    iMnth = CInt(sMnth)
   
    'check if month in output array
    For lR2 = 2 To UBo1 - 1
        If Month(vFill(lR2, 1)) = iMnth Then Exit For
    Next lR2
    If lR2 = UBo1 Then
        'month not in output array yet, so add
        vFill(lR2, 1) = VBA.DateSerial(Year(Date), iMnth, 1)
    End If
    'lr2 now contains row where we need to add the product values
   
    ' the product names are held in row 1 of the output array
    'loop through the input array to get product name and value
   
    For lR1 = 2 To UBound(vInp, 1)      '<<<< if no header row in Tab1, change to lR1 = 1
        'find product in output array
        For lC2 = 2 To UBo2
            If vInp(lR1, 1) = vFill(1, lC2) Then Exit For
        Next lC2
        If lC2 > UBo2 Then  'product not found
            'make output array larger for new product
            ReDim Preserve vFill(1 To UBo1, 1 To UBo2 + 1)
            UBo2 = UBo2 + 1
            'put name in first row
            vFill(1, lC2) = vInp(lR1, 1)
            'enter 0 in the previous months
            For lR3 = 2 To lR2 - 1
                vFill(lR3, lC2) = 0
            Next lR3
        End If
        'add value for product in selected column for the month (held as lR2)
        vFill(lR2, lC2) = vInp(lR1, 2)
       
    Next lR1
   
'    'transpose the tFill array to the output array. The worksheet function does not work proerly with dates
    ReDim vOutp(1 To UBo2, 1 To UBo1)
    For lR2 = 1 To UBo2
        For lC2 = 1 To UBo1
            If lR2 = 1 And lC2 > 1 Then
                If Len(vFill(lC2, lR2)) Then
                    vOutp(lR2, lC2) = DateValue(vFill(lC2, lR2))
                End If
            Else
                vOutp(lR2, lC2) = vFill(lC2, lR2)
            End If
        Next lC2
    Next lR2
    'now dump vfill to the sheet
'    vOutp = WorksheetFunction.Transpose(vFill)
    rOut.Resize(UBo2, UBo1) = vOutp
   
End Sub

Thank you it seems to be working well just sometimes it hits a runtime error 13 can i do anything to stop this?

 

[sijpie]

When it shows the error, click on the debug button. This will open the VBA editor where one line of code is highlighted in yellow. Somewhere in that line the error has occurred. Let me know which line it is.