Finding & filling in other Excel sheets based on criteria using VBA - excel

Question

I have a workbook with four worksheets: Overview, apple, banana and pear.
In the sheet overview I have a 3x3 table:
In Out Extra
apple
banana
pear
Cell H5 in Overview contains a date of 2019, which can be selected via a drop-down menu
In each of the apple/banana/pear sheets, I have a 365x3 table:
In Out Extra
1-1-2019
2-1-2019
3-1-2019
.
.
.
31-12-2019
I would like to run a macro so that the In, Out and Extra values from the Overview sheet are filled in the correct worksheet and behind the correct date in that worksheet.
The goal would be that people fill in the overview sheet (In, Out and Extra values as well as a date), they run the macro, and data is automatically stored in the right cell in the right worksheet.
This is a relatively easy example, the actual workbook for which I need this macro has more that 70 "fruits".
I know the code below doesn't work, but I'll hope to show my way of thinking
Sub export()
Dim ws As Worksheet 'worksheet
Dim currentdate As Date 'datum
Dim fruit As String 'Fruit
Worksheets("Overview").Activate 'activate worksheet Overview
currentdate = ActiveSheet.Cells(H5) 'select date value
fruit = Overview.Range(“C6, C8”) 'select range of the fruits
For Each ws In Worksheets 'loop over every worksheet except the Overview sheet
If ws.Name = fruit Then 'crossreference name worksheet with fruit in Overview sheet
ws.Activate 'activating the selected worksheet
If ws.Range("A1:A365") = currentdate Then 'looking for the correct date in the selcted worksheet
fruit = ws.Name
Next ws
End Sub

Answer 1

Vba solution for this:
For this solution to work properly, you should make the sheets APPLE, BANANA and PEAR share same structure. In my example, all this 3 sheets have in column A the date, column B is IN, column C is OUT and column D is EXTRA
Also, in OVERVIEW sheet, make sure the terms APPLE, BANANA and PEAR are exactly equal to names of each sheet (this means no extra spaces, blanks or different chars).
And OVERVIEW must be the active sheet.
My button IMPORT is linked to this code to import data. I want to import data from 17/05/2019 (the yellow rows)
Sub IMPORT_DATA()
Application.ScreenUpdating = False
Range("B2:D4").Clear
Dim i As Long
Dim TargetRow As Long
Dim TargetSheet As String
Dim TargetDate As Date
TargetDate = Range("B6").Value
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row Step 1 'i=2 because dats in OVERVIEW stars at row 2, and Column A
TargetSheet = Range("A" & i).Value
'first, we make sure the date from B6 exists in the target worksheet counting
With Application.WorksheetFunction
If .CountIf(ThisWorkbook.Worksheets(TargetSheet).Range("A:A"), TargetDate) > 0 Then
TargetRow = .Match(CDbl(TargetDate), ThisWorkbook.Worksheets(TargetSheet).Range("A:A"), 0)
Range("B" & i).Value = ThisWorkbook.Worksheets(TargetSheet).Range("B" & TargetRow).Value 'IN value
Range("C" & i).Value = ThisWorkbook.Worksheets(TargetSheet).Range("C" & TargetRow).Value 'IN value
Range("D" & i).Value = ThisWorkbook.Worksheets(TargetSheet).Range("D" & TargetRow).Value 'IN value
End If
End With
Next i
Application.ScreenUpdating = True
End sub
And after executing this code I get in OVERVIEW:
Now I want to export some values to data, and I use this code:
Sub EXPORT_DATA()
Application.ScreenUpdating = False
Dim i As Long
Dim TargetRow As Long
Dim TargetSheet As String
Dim TargetDate As Date
TargetDate = Range("B6").Value
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row Step 1 'i=2 because dats in OVERVIEW stars at row 2, and Column A
TargetSheet = Range("A" & i).Value
'first, we make sure the date from B6 exists in the target worksheet counting
With Application.WorksheetFunction
If .CountIf(ThisWorkbook.Worksheets(TargetSheet).Range("A:A"), TargetDate) > 0 Then
TargetRow = .Match(CDbl(TargetDate), ThisWorkbook.Worksheets(TargetSheet).Range("A:A"), 0)
ThisWorkbook.Worksheets(TargetSheet).Range("B" & TargetRow).Value = Range("B" & i).Value 'IN value
ThisWorkbook.Worksheets(TargetSheet).Range("C" & TargetRow).Value = Range("C" & i).Value 'OUT value
ThisWorkbook.Worksheets(TargetSheet).Range("D" & TargetRow).Value = Range("D" & i).Value 'EXTRA value
End If
End With
Next i
MsgBox "data exported"
Application.ScreenUpdating = True
End Sub
And after executing code, check new data (yellow rows):
Hope this helps a litte bit and you can adapt to your needs.