Excel VBA - Copy Paste Range in column if Date matches - vba

My macro is used to copy/paste live data to overwrite an old budget.
Essentially I want to do the following:
If the date in T6 = date in Range(G6:R6) then copy Range(T10:T30) to Range(?10:?30), where ? is the column of the cell that matched the date.

This should match what you're asking for. In the future, you should share the code that you've attempted so far.
Dim cell As Range
For Each cell In Range("G6:R6")
If cell.value = Range("T6").value Then
Range(Cells(10, cell.Column), Cells(30, cell.Column)).value = Range("T10:T30").value
End If
Next cell

Related

VBA If/Else Statement to Copy and Paste Data Based on Count of Column

I am trying to copy and paste data from the same column (A) in multiple sheets into a single column of a data in a final sheet.
The code I have used so far works perfectly if there is more than one row of data beneath the header row.
The sheet is formatted to include a table beneath the data and if there is only one row of data on the sheet the existing code will copy data from cell A2 to the first cell in the table with data (essentially performing ctrl+shift+down).
I need an if statement to count a range of data (could be A2:A3) and if the count is greater than 1 it would copy all the data down the column to first empty row. Then paste it to the first empty row in Column A of another sheet. Else copy cell A2 and then paste it to the first empty row in column A of another sheet.
Sheets("Sheet1").Select
If Range("A2:A3").Count > 1 Then
Range("A2",Range("A2").End(xlDown)).Copy Destination:=Sheets("QA").Range("A" & Rows.Count).End(xlUp).Offset(1)
ElseIf Range("A2:A3").Count = 1 Then
Range("A2").Copy Destination:=Sheets("QA").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
This will work. You really just need to check if A3 has data.
With Worksheets("Sheet1")
Dim source as Range
If Len(.Range("A3")) then
Set source = .Range(.Range("A2"),.Range("A2").End(xlDown))
Else
Set source = .Range("A2")
End If
End With
Dim dest as Range
Set dest = Worksheets("QA").Range("A" & Rows.Count).End(xlUp).Offset(1)
dest.Resize(source.Rows.Count,1).Value = source.Value

Copy rows based on cell value and paste on a new sheet

Check This
I need a help. I want to copy whole cell from A sheet name "Components" only if value in Column C is > 0 to a new Sheet name "Load list"
Can someone please give me the macro code for this?
on your new sheet you can add this condition the cell or range of cells:
=IF(Components!C5>0,Components!A5)
where C5 has thevalue to compare, and A5 has the value copy if the condition happens.
Right in my swing!
The formula given by #sweetkaos will work fine, in case you want to replicate the data as it is with blanks where data is not found.
I will imagine a slightly more complicated situation. I am assuming you want just one line in the next format as is shown in your image.
Also conveniently assuming the following:
a. both sheets have fixed start points for the lists
b. 2 column lists - to be copied and pasted, with second column having value
c. Continuous, without break source list
d. basic knowledge of vba, so you can restructure the code
Here is the code. Do try to understand it line by line. Happy Excelling!
Sub populateLoadList()
'declaring range type variables
Dim rngStartFirstList As Range, rngStartLoadList As Range
'setting values to the range variables
'you must change the names of the sheets and A1 to the correct starts of your two lists
Set rngStartFirstList = Worksheets("Name_of_your_fist_sheet").Range("A1")
Set rngStartLoadList = Worksheets("Name_of_your_second_sheet").Range("A1")
Do While rngStartFirstList.Value <> ""
If rngStartFirstList.Offset(1, 0).Value < 0 Then
Range(rngStartFirstList, rngStartFirstList.Offset(0, 1)).Copy
rngStartLoadList.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Set rngStartLoadList = rngStartLoadList.Offset(1, 0)
End If
Set rngStartFirstList = rngStartFirstList.Offset(1, 0)
Loop
End Sub
Basically what i want is ... if Value on C is >0 i want whole column 10 copied to that new sheet .... not only that cell

How do I insert multiple date columns in order to meet a specific date?

I am really new to codes and Excel VBA, and hopefully, you guys could help me out with my question. Any tips, feedback, and comments are greatly appreciated!
Within a workbook, I want to make sure that my cell (I1) of worksheet (Sheet1) has the specific date as written in a different sheet (ie. Menu). I want I1 to be the starting point whereby subsequent dates will occur by going across the row (I1, J1, K1, etc.). In this case, if my specific date required is 15/8/16 and one of my sheet (Sheet 1) has its cell I1 written as 20/8/16, I want to know how to construct my code in such a way that,
If I1 in Sheet 1 is currently at 15/8/16, then do nothing. But if I1 in Sheet 1 is off a different later date than 15/8/16, the I1 will now begin at 15/8/16, and subsequent dates are added until it reaches the default date that was initially there at I1 (now 20/8/16 is at cell N1).
My current code is as follows:-
If ActiveSheet.Range("I1") <> MainSht.Range("D6") Then
ActiveSheet.Range("I1") = MainSht.Range("D6")
End If
Do
If Cells(1,z+1)>Cells(1,z+1) Then
Cells(1,z+1) = Cells(1,z)+1
End If
z = z+1
Loop Until Cells(1,z+1) = MainSht.Range("D7")
*Mainsht (D6) is my start date, (D7) is my end date.
My code currently does not have the insert column section because I have problems in applying both insert column and date increment code together. With my current code, my date range never expanded as it is still within the same earlier date range (same last column as before, hence last cell for date column remains as it is). How do I construct in such a way that the missing dates in between are added, and it is added by inserting columns in a repeated process?
Thanks in advance if anyone could help me out in this. Thanks for your understanding as well.
Please check below code to add columns
Dim start_date, end_date As Date
start_date = ThisWorkbook.Sheets("Sheet1").Range("L1").Value
end_date = ThisWorkbook.Sheets("main").Range("D7").Value
If start_date < end_date Then
Do Until start_date = end_date
ThisWorkbook.Sheets("Sheet1").Activate
Range("L:L").Insert (xlRight)
start_date = start_date + 1
Range("L1").Value = start_date
Loop
End If
you could try this:
Option Explicit
Sub main()
Dim diff As Long
With Worksheets("Work").Range("I1") '<--| reference working sheet range "I1" (change "Work" to your actual working worksheet)
diff = .Value - Worksheets("Menu").Range("D6") ' <--| evaluate the difference between referenced range value and worksheet "Menu" cell "D6" (change "Menu" to your actual "main" sheet)
If diff > 0 Then
With .Resize(, diff) '<-- reference referenced range resized to the necessary columns number
.EntireColumn.Insert xlRight '<-- insert columns
With .Offset(, -diff).Resize(1) '<--| reference referenced range first row
.FormulaR1C1 = "=RC[1]-1" ' <--| insert formulas that substracts one from the value of next cell on the right
.Value = .Value '<-- get rid of formulas
.NumberFormat = .Offset(, diff).Resize(, 1).NumberFormat '<--| format cells as the passed range
.EntireColumn.AutoFit '<--| adjust columns width
End With
End With
End If
End With
End Sub
Just change "Work" and "Menu" to your actual worksheets names

How can I copy & paste entire rows with distinct values to a new sheet on varying cell ranges?

I know there's many StackOverlow Q&A's on copying & pasting from a cell value in VBA. However, I can't seem to make it work for my own project. I want to copy the entire row(s) if it matches the Distinct Store# (non incremental) in Column H into a new sheet (in this code below, "Sheet1") which already has a template layout where I copy/paste the values. The template looks the same on every sheet before any data is filled in, except the first 2 tabs which have the data ("Appointments" and "Invoices").
I came up with the VBA below, but here's the catch- the cell# that it pastes the row(s) (in the code below, "A10") changes based on the Store #. This is because I am copying rows from the 1st sheet ("Appointments") in the workbook from the distinct Store#, then deleting the empty rows above the area where the 2nd sheet ("Invoices") data goes. Some stores may return 10 rows or none at all. The Case, which is the Store #, is currently manually put in one by one. Should it be an array instead?
Anyway...I was hoping to automate the copying/pasting and loop for each store to their sheet. Maybe I'm going about this wrong, but would anyone be kind enough to suggest how to solve my error code "Method or data member not found." as well as provide any suggestions on making my code better for a loop for filtered cell copying to different spots for each sheet.
Simple explanation of my step by step process:
1.Filter Store # from "Appointments" sheet.
2. Copy all rows for that store and paste into a new sheet with template named "Sheet1" in B3.
3. Filter Store # from "Invoices" sheet.
4. Copy all rows for that store and paste into the previously made sheet named "Sheet" under the above rows. (Some stores do not have invoices, so this section is blank/NULL). Paste destination cell for "Invoices" will be different for each store# depending on how many rows they get from the "Appointments" sheet (could be A10 or A25).
5. LOOP- Next store #, next sheet (sheet2).
Sub CopyToNewSheetInv()
Dim i As Range
Dim book As Workbooks
Dim sheet1 As Worksheets
Dim sheet2 As Worksheets
Set book = Workbooks("SampleWorkbookName")
Set sheet1 = Worksheets("AllInvoices")
Set sheet2 = Worksheets("Sheet1")
For Each i In sheet1.Range("H:H")
Select Case i.Value
Case 1243
sheet2.Range("A10").End(xlUp).Offset(1, 0).EntireRow.Value = i.EntireRow.Value
Case Else
End Select
Next i
End Sub
Try this:
Sub CopyToNewSheetInv()
Dim i As Range
Dim book As Workbook
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Set book = Workbooks("SampleWorkbookName.xlsx")
Set sheet1 = book.Worksheets("AllInvoices")
Set sheet2 = book.Worksheets("Sheet1")
'iterate only thorugh those cells in H that have data, not all 1.04 million
For Each i In sheet1.Range("H1", sheet1.Range("H" & sheet1.Rows.Count).End(xlUp))
Select Case i.Value
Case 1243,"1243"
sheet2.Rows(sheet2.Range("A10000").End(xlUp).Offset(1, 0).Row).Value = sheet1.Rows(i.Row).Value
Case Else
End Select
Next i
End Sub

Copy all Rows in excel sheet only if specific cell = today's date

I'm knew to vb scripting for excel and cant seem to find code that will help do what i want. maybe its how im wording my search criteria.
Sheet 1 is an input sheet which saves data into sheet 2 every day. There is a cell that holds the current date.
So sheet 2 just collates and saves everything entered.
Each day there are several rows saved into sheet 2.
I need a button on sheet two that only selects the rows that have today's date and copies the content. I just need that data copied so i can then paste this into off clipboard into another application.
Can anyone help? im using office 2016.
Thanks
Excel VBA, How to select rows based on data in a column?
I believe this is something that would be useful for yourself since you are new to VBA code.
You will most likely need to supplement your code with the parts you ned, IE current date, only coping and not pasting and so forth.
I recommend google for those parts as it is widely avalible, I.E. VBA Excel "then what you are searching for"
Dim TodaysDate As Date
TodaysDate = Now
TodaysDate = Format(TodaysDate, "dd/mm/yyyy")
^ For instance will give you the current day in dd/mm/yyyy format
I leave the rest to you, hope this helps
I would loop through the rows in the second sheet and hide the rows not matching the date. So something similar to this:
Dim today As String
Dim Rows As Integer
Dim Sheetname As String
Dim Column As Integer
Sheetname = "Sheet2" 'Name of your second sheet
Column = 1 'Column with your date
today = Now
today = Format(today, "dd/mm/yyyy")
Rows = Sheets(Sheetname).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Dim i As Integer
For i = 1 To Rows Step 1
If Sheets(Sheetname).Cells(i, Column).Value <> today Then
Sheets(Sheetname).Rows(i).EntireRow.Hidden = True
End If
Next i
Then you can copy the rows of today.
To show all rows again, simply use
Dim Sheetname As String
Sheetname = "Sheet2" 'name of your second sheet
Sheets(Sheetname).Cells.EntireRow.Hidden = False