Combine two Macro Codes together

NewbieVBA · May 24th 2016

Hi y'all

I am new at VBA and on this forum. Hopefully, you can help me
I have some difficulties with doing the following:
I have written several macros which look up the correct values (from different sheets) with the desired date.
I will share a part of my syntax.

Code

last_r2 = Sheets("sheet3").Range("A3").End(xlDown).Row ' this is the column with the different dates
last_r1 = Sheets("sheet2").Range("A3").End(xlDown).Row
last_column1 = Sheets("sheet2").Range("B2").SpecialCells(xlCellTypeLastCell).Column
last_column2 = Sheets("sheet3").Range("B1").SpecialCells(xlCellTypeLastCell).Column


Dim lngcolumn8 As Long: lngcolumn8 = 12
Do Until IsEmpty(Sheets("sheet3").Cells(2, lngcolumn8))
If Sheets("sheet3").Cells(last_r2, 1) > Sheets("sheet3").Cells(last_r2 - 1, 1) Then 'if the current date is larger than the previous one then
Sheets("sheet3").Cells(last_r2 - 1, lngcolumn8).Copy
Sheets("sheet3").Cells(last_r2, lngcolumn8).Insert shift:=xlDown
lngcolumn8 = lngcolumn8 + 4
End If
Loop


Dim lngloop As Long: lngloop = 12
Do Until IsEmpty(Sheets("sheet3").Cells(1, lngloop))
For Each cell In Sheets("sheet3").Range(Sheets("sheet3").Cells(last_r2, 9), Sheets("sheet3").Cells(last_r2, last_column2))
If IsEmpty(cell) Then
cell = Application.WorksheetFunction.Index(Sheets("sheet2").Range(Sheets("sheet2").Cells(1, 1), Sheets("sheet2").Cells(last_r1, last_column1)), Application.Match(CLng(Sheets("sheet3").Cells(last_r2, 1)), Sheets("sheet2").Range(Sheets("sheet2").Cells(1, 1), Sheets("sheet2").Cells(last_r1, 1)), 0), Application.Match(Sheets("sheet3").Cells(1, lngloop), Sheets("sheet2").Range(Sheets("sheet2").Cells(2, 1), Sheets("sheet2").Cells(2, last_column1)), 0) + 1)
lngloop = lngloop + 4
End If
Next
Loop

Display More

This works perfectly per row, because I add the dates manually.
Now I want this to work automatically, but I have difficulties writing the syntax.

I have a macro code which automatically fills the dates between the last updated date and the current date (see second code).
With the third code, I tried to see if it possible for each new date that the amount of the previous date is added with 4:

Code

StartDate = Sheets("sheet3").Range("A6").Value
EndDate = Date
NoDays = EndDate - StartDate + 1
Sheets("sheet3").Range("A6").Value = StartDate
Sheets("sheet3").Range("A6").Resize(NoDays).DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:=xlWeekday, Step:=1, Stop:=EndDate, Trend:=False


Dim i As Long: i = 2
Do Until IsEmpty(Sheets("sheet3").Cells(i, 1))
If Sheets("sheet3").Cells(i, 1) > Sheets("sheet3").Cells(i - 1, 1) Then
Sheets("sheet3").Cells(i, 2) = Sheets("sheet3").Cells(i - 1, 2) + 4
i = i + 1
End If
Loop

Display More

I have tried to nest the first syntax within the second syntax and switch last_r2 with i, but this did not work.
In short, I want to maintain the functionality of the first syntax combined with the autofill between two dates.

Hopefully, I explained my problem correctly and hopefully someone can help me in the right direction

In advance I would like to thank you for taking the time to read my thread

skywriter · May 25th 2016

Re: Combine two Macro Codes together

I can look at this tomorrow. :cool:

My replying to this will bump it to the top of the board, so perhaps you will get help sooner.

skywriter · May 25th 2016

Re: Combine two Macro Codes together

Not quite clear as to what you want.

Perhaps a sample workbook so I can see some data and some notes in the workbook would be helpful?

When you click reply there will be a new button labeled go advanced, click on that button then there will be a paperclip icon in the toolbar, click on that icon and follow the instructions to upload a workbook.

NewbieVBA · May 25th 2016

Re: Combine two Macro Codes together

Hi Skywriter,

Hereby I send you a sample workbook. Hopefully this makes it much clearer.
forum.ozgrid.com/index.php?attachment/69235/
Thanks

skywriter · May 25th 2016

Re: Combine two Macro Codes together

Forgetting your code, can you just explain what you want to do now?

What do you want to enter, or what do you specifically want the code to do and be specific as to what you want the code to look at.

For instance you could say I want an input box to come up and I will type a beginning and ending date and I want the data from sheet ? that falls in this date range copied to sheet? and the columns to fit the new data.

I don't want to read your code to figure it out, I want specifics as to what you want to happen, how it will happen and what data it is based on.

NewbieVBA · May 28th 2016

Re: Combine two Macro Codes together

I just solved my problem.
Thanks for taking the time to look at it

**S O** · May 28th 2016

Re: Combine two Macro Codes together

NewbieVBA - Perhaps you could share your solution so that others can see how you managed it?

skywriter - for future reference, you can type [noparse][sw]*[/sw][/noparse] which will generate a peice of text explaining how to attach a sample workbook - save you a few keystrokes

skywriter · May 28th 2016

Re: Combine two Macro Codes together

@SO Thanks for the info.

I actually have my version saved in a program called Speed Typing.

I type 4 upload with no space between the number and word.

:cheers:

NewbieVBA · Jun 4th 2016

Re: Combine two Macro Codes together

@ SO
I took my syntax and placed into a loop like this:

Code

last_r2 = Sheets("sheet3").Range("A3").End(xlDown).Row ' this is the column with the different dates
last_r1 = Sheets("sheet2").Range("A3").End(xlDown).Row 
last_column1 = Sheets("sheet2").Range("B2").SpecialCells(xlCellTypeLastCell).Column 
last_column2 = Sheets("sheet3").Range("B1").SpecialCells(xlCellTypeLastCell).Column 
 
For i = 6 To last_r2
Dim lngcolumn8 As Long: lngcolumn8 = 12 
Do Until IsEmpty(Sheets("sheet3").Cells(2, lngcolumn8)) 
    If Sheets("sheet3").Cells(last_r2, 1) > Sheets("sheet3").Cells(last_r2 - 1, 1) Then 'if the current date is larger than the previous one then
        Sheets("sheet3").Cells(last_r2 - 1, lngcolumn8).Copy 
        Sheets("sheet3").Cells(last_r2, lngcolumn8).Insert shift:=xlDown 
        lngcolumn8 = lngcolumn8 + 4 
    End If 
Loop 
 
Dim lngloop As Long: lngloop = 12 
Do Until IsEmpty(Sheets("sheet3").Cells(1, lngloop)) 
    For Each cell In Sheets("sheet3").Range(Sheets("sheet3").Cells(last_r2, 9), Sheets("sheet3").Cells(last_r2, last_column2)) 
        If IsEmpty(cell) Then 
            cell = Application.WorksheetFunction.Index(Sheets("sheet2").Range(Sheets("sheet2").Cells(1, 1), Sheets("sheet2").Cells(last_r1, last_column1)), Application.Match(CLng(Sheets("sheet3").Cells(last_r2, 1)), Sheets("sheet2").Range(Sheets("sheet2").Cells(1, 1), Sheets("sheet2").Cells(last_r1, 1)), 0), Application.Match(Sheets("sheet3").Cells(1, lngloop), Sheets("sheet2").Range(Sheets("sheet2").Cells(2, 1), Sheets("sheet2").Cells(2, last_column1)), 0) + 1) 
            lngloop = lngloop + 4 
        End If 
    Next 
Loop 
Next

Display More

And it works

**S O** · Jun 4th 2016

Re: Combine two Macro Codes together

Thanks for coming back and posting, I'm sure many others will find this helpful in future.

Combine two Macro Codes together

Participate now!

Share