This macro may not be set out correctly/efficiently but it works so i didn't dare change it. I recorded it and didn't impute to much manually.
Basically I change the dates daily which is fine but I was thinking is there a way to loop the macro changing the cells highlighted in bold after each time the macro completes? i.e F107 becomes F108? Until there is no value in column F workbook cards? If this last part is too complicated i could just count the amount of times i need it to loop and enter that instead. Thanks
Sub Purge()
Workbooks("Memos 04.09.2020").Sheets("Memos").Range("A1").AutoFilter Field:=4, Criteria1:=Workbooks("Cards 04.09.2020").Sheets("Cards").Range _ (**"F107"**).Value
Workbooks("Transactions 04.09.2020").Sheets("Transactions").Range("A1").AutoFilter Field:=2, Criteria1:=Workbooks("Cards 04.09.2020").Sheets("Cards").Range _ (**"F107"**).Value
Dim objWord As New Word.Application
Workbooks("Cards 04.09.2020").Sheets("Cards").Range _ ("**B107**:**C107**").Copy
With objWord
.Documents.Add
.Selection.PasteAndFormat (wdFormatPlainText)
.Selection.TypeParagraph
.Visible = True
Workbooks("Cards 04.09.2020").Sheets("Cards").Range _ ("**D107:F107**").Copy
.Selection.PasteAndFormat (wdFormatPlainText)
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeText ("Transactions")
.Visible = True
Workbooks("Transactions 04.09.2020").Sheets("Transactions").Range("E:G").Copy
.Selection.PasteExcelTable False, True, False
.Selection.TypeParagraph
.Visible = True
Workbooks("Memos 04.09.2020").Sheets("Memos").Range("E:K").Copy
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeText ("Memos")
.Selection.PasteExcelTable False, True, False
.Visible = True
End With
End Sub
Basically I change the dates daily which is fine but I was thinking is there a way to loop the macro changing the cells highlighted in bold after each time the macro completes? i.e F107 becomes F108? Until there is no value in column F workbook cards? If this last part is too complicated i could just count the amount of times i need it to loop and enter that instead. Thanks
Sub Purge()
Workbooks("Memos 04.09.2020").Sheets("Memos").Range("A1").AutoFilter Field:=4, Criteria1:=Workbooks("Cards 04.09.2020").Sheets("Cards").Range _ (**"F107"**).Value
Workbooks("Transactions 04.09.2020").Sheets("Transactions").Range("A1").AutoFilter Field:=2, Criteria1:=Workbooks("Cards 04.09.2020").Sheets("Cards").Range _ (**"F107"**).Value
Dim objWord As New Word.Application
Workbooks("Cards 04.09.2020").Sheets("Cards").Range _ ("**B107**:**C107**").Copy
With objWord
.Documents.Add
.Selection.PasteAndFormat (wdFormatPlainText)
.Selection.TypeParagraph
.Visible = True
Workbooks("Cards 04.09.2020").Sheets("Cards").Range _ ("**D107:F107**").Copy
.Selection.PasteAndFormat (wdFormatPlainText)
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeText ("Transactions")
.Visible = True
Workbooks("Transactions 04.09.2020").Sheets("Transactions").Range("E:G").Copy
.Selection.PasteExcelTable False, True, False
.Selection.TypeParagraph
.Visible = True
Workbooks("Memos 04.09.2020").Sheets("Memos").Range("E:K").Copy
.Selection.TypeParagraph
.Selection.TypeParagraph
.Selection.TypeText ("Memos")
.Selection.PasteExcelTable False, True, False
.Visible = True
End With
End Sub