Picking your brains here. Trying to do this for days. VBA noob.
Two Sheets: Sourcesheet ("NB & COax PO Detail Test") & Outputsheet ("New build & Coax Test")
Source sheet is an organized list. POs are in Col I and each POs value is broken down by month (J,F til dec). Each row has is dedicated to a unique PO with the monthly forecast broken down by month.
Output Sheet has the POs listed in Rows and Monthly forecast in Columns. The idea is to vlookup the monthly forecast for each PO in source sheet, if the Col C (output sheet) is PO Materials or PO Labor then Vlookup, otherwise skip to next row. Vlookup has to apply the monthly forecast to each month. After each Vlookup I am trying to copy and paste the value so that there isnt too much coding leading to Excel crash. Also in the Source sheet the Col Index Num for the Output Sheet vlookup is listed above each month.
In a nutshell.
If(Or (Outputsheet.Col I ="PO Labor", Outputsheet.Col I ="PO Materials"), Vlookup(Outputsheet.ColE, SourceSheet.Range(Col I to Col AB:5000), SourceSheetR3,False), "") Copy and Paste next Column in the same row repeat until OutputSheet Col R. Copy and paste. Next row.
SourceSheet R3 is variable it changes so I want Vlookup to pick up the Column number from there as stated above each month of the Col.
(Output Sheet & Source Sheet Click the next image) http://imgur.com/SHANSLF&ydjQfb3#0
(Code) http://imgur.com/MieCu5G
Finally finished this with the help of several genereous memebers of this community and Chandoo Community. here is the final code that I put together and that actually works.
Sub MakeFormulas()
Dim SourceLastRow As Long
Dim OutputLastRow As Long
Dim sourceSheet As Worksheet
Dim outputSheet As Worksheet
Dim X As Long
Dim Z As Long
'What are the names of our worksheets?
Set sourceSheet = Worksheets("Sheet1")
Set outputSheet = Worksheets("Sheet2")
'Determine last row of source
With sourceSheet
SourceLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With outputSheet
'Determine last row in col C
OutputLastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
For y = 17 To 28 'Q to AB
For X = 2 To OutputLastRow
If InStr(1, .Range("C" & X), "PO Materials") + InStr(1, .Range("C" & X), "PO Labor") > 0 And Cells(2, y) = "Forecast" Then
'Apply formula
.Cells(X, y).Value = _
Evaluate("=VLOOKUP($E" & X & ",'" & sourceSheet.Name & "'!$A$2:$L$" & SourceLastRow & ",Match(" & Cells(1, y).Address & ",'" & sourceSheet.Name & "'!$A$1:$AD$1,0),0)")
End If
Next
Next
End With
End Sub
Related
I am stuck i don't know what code to use so i can search the same column twice for 2 different keyword and then copy data from the same row to another spreadsheet in sequence from a start cell. for details here's what i am trying to do.
Limit the search within a range of the worksheet (ex. Sheet 1 B1:N:200)
Search the 8th column (I) of the limit range Sheet1 for keyword ("Goods")
Copy the data found in the 2nd (C) and 5th column (F) of same row where instance "Goods " is found
Paste Value of Sheet 1 - column 2 to Sheet2 - Column 3 (no format values only), and Sheet 1 column 5 to Sheet 2 Column4 (with format and values) on a specific starting point (ex. Sheet 2 - B3) Next Match Result will be Sheet 2 - B4 and so on
5.Search AGAIN the 8th column of Sheet1 for keyword ("Services") starting from the top (B1:N1)
6.Copy the data found in the 2nd (C) and 5th column (F) of same row where instance "Services" is found
Paste Value of Sheet 1 - column 2 to Sheet2 - Column 3 (no format values only), and Sheet 1 column 5 to Sheet 2 Column4 (with format and values) to next row after the last PASTE from "Goods" was done. (ex last row match paste was C35 and D35 new found value should be paste in C36 a D36)
Ending Output should be all "Goods" results first then "Services" results
I hope i have conveyed what i need clearly
I am trying to work on this code that i found here but i just don't get how to insert the 2nd search loop for services., how to paste on specific cell in sheet2, how to follow the last row for services paste
Sub CopyCells
Dim lngLastRowSht1 As Long
Dim lngLastRowSht2 As Long
Dim counterSht1 As Long
Dim counterSht2 As Long
With Worksheets(1)
lngLastRowSht1 = .Cells(.Rows.Count, 8).End(xlUp).Row
lngLastRowSht2 = Worksheets(2).Cells(Worksheets(2).Rows.Count, 5).End(xlUp).Row
For counterSht1 = 1 To lngLastRowSht1
For counterSht2 = 1 To lngLastRowSht2
If Sheets(1).Range("" & (counterSht1)).Value = "Goods" Then
Sheets(2).Range("B" & (counterSht2), "D" & (counterSht2)).Value = Sheets(1).Range("C" & counterSht1, "D" & counterSht1).Value
End If
Next counterSht2
Next counterSht1
End With
End Sub
Edit1
As per request of sir Chris this is how it should look like
Answer for this Query was best solved by #CDP1802 Worked as needed.
I learned that I needed 2 counters for it to work :) and I also learned how to properly label target destination.
Thank you for this community:)
Increment the target row after each copy.
Option Explicit
Sub CopyCells()
Const ROW_START = 3
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim n As Long, r As Long, lastrow1 As Long, lastrow2 as Long
Dim keywords, word, t0 As Single: t0 = Timer
keywords = Array("Goods", "Services")
Set wb = ThisWorkbook
Set ws1 = wb.Sheets(1)
Set ws2 = wb.Sheets(2)
lastrow2 = ROW_START
Application.ScreenUpdating = False
With ws1
lastrow1 = .Cells(.Rows.Count, "I").End(xlUp).Row
For Each word In keywords
For r = 1 To lastrow1
If Len(.Cells(r, "I")) = 0 Then
Exit For
ElseIf .Cells(r, "I") = word Then
'Sht1 col 2 to Sht2 Col 3 (no format values only)
'Sht1 col 5 to Sht2 Col 4 (with format and values)
ws2.Cells(lastrow2, "C") = .Cells(r, "B")
ws2.Cells(lastrow2, "D") = .Cells(r, "E")
.Cells(r, "E").Copy
ws2.Cells(lastrow2, "D").PasteSpecial xlPasteFormats
lastrow2 = lastrow2 + 1
n = n + 1
End If
Next
Next
End With
Application.ScreenUpdating = True
MsgBox r - 1 & " rows scanned " & vbLf & n & " rows copied", _
vbInformation, Format(Timer - t0, "0.0 secs")
End Sub
You could make two routines: one for services and one for goods. But that code and the code above isn't very efficient.
Since Services & Goods are in the same column, try using the autofilter:
Sheets(2).UsedRange.autofilter Field:=8, Criteria1:=Array("Goods", "Services"), VisibleDropDown:=False, Operator:=xlFilterValues
Sheets(2).UsedRange.SpecialCells(xlCellTypeVisible).Copy
Sheets(1).Range("A1").PasteSpecial
Application.CutCopyMode = False
I need your help with VBA!
I want to write a code that will sum the "sales" column in different 7 sheets. The problem is that the column has a different location in each sheet and a dinamic rows' count. The sum should be in the last row + 1.
I am not very good at macros, but I guess I should start with checking i to 7 sheets. Then I should sum a range based on the header ("Sales"). I am lost about how to write all of this..
Try the next code, please:
Sub SumSales()
Dim sh As Worksheet, rngS As Range, lastRow As Long
For Each sh In ActiveWorkbook.Sheets 'iterate through all sheets
'find the cell having "Sales" text/value
Set rngS = sh.Range(sh.Cells(1, 1), sh.Cells(1, _
sh.Cells(1, Columns.count).End(xlToLeft).Column)).Find("Sales")
'if the cell has been found (the cell range is NOT Nothing...)
If Not rngS Is Nothing Then
'Determine the last row of the found cell column:
lastRow = sh.Cells(Rows.count, rngS.Column).End(xlUp).row
'Write the Sum formula in the last empty cell:
rngS.Offset(lastRow).formula = "=Sum(" & rngS.Offset(1).address & _
":" & sh.Cells(lastRow, rngS.Column).address & ")"
sh.Range("A" & lastRow + 1).Value = "Sum of sales is:"
Else
'if any cell has been found, it returns in Immediate Window (Being in VBE, Ctrl + G) the sheet names not having "Sales" header:
Debug.Print "No ""Sales"" column in sheet """ & sh.name & """."
End If
Next
End Sub
I'm looking to create a macro that will display the Sum from a set column of each of multiple sheets. I need the total of column "K" to be shown 1 row from the last entry of a variable number of entries. It is a requirment that this is in VBA as it needs to run with a number of other functions.
I've tried the below code but it does not give the expected result and seems to be drawing data from other sheets.
Sub SumWorksheets()
Dim LastRow As Long
Dim ws As Worksheet
For Each ws In Worksheets
LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("K" & LastRow + 1) = Application.WorksheetFunction.Sum(Range("K2:K" & ws.Rows.Count))
Next
End Sub
I want the Total of all numbers in Column "K" to display 2 rows below the last number in Row "K"
Declared and fully use ws and LastRow variables. Not using can cause code to pull values from another worksheet. Per comment from #LoveCoding, using a different column as the LastRow can overwrite a cell in Col K. You should have used the LastRow variable, in the Sum function.
Dim ws As Worksheet, LastRow As Long
For Each ws In ThisWorkbook.Worksheets
LastRow = ws.Range("K" & ws.Rows.Count).End(xlUp).Row
ws.Range("K" & LastRow + 1) = Application.WorksheetFunction.Sum(ws.Range("K2:K" & LastRow))
Next
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
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.
I have been trying some time now with the following problem: First code (not listed here) drops data in sheet EDD in column B (B45 to be precise), then each cell in col A is populated with number 1 (from A45 to the bottom of column B) - as the code below shows.
Now the problem is that I will be adding another set of data in column B (to the bottom of what has already been added) but this time this new data will have number 2 in each cell of the column A (ps. I cannot overwrite number 1's that I have already entered) - the issue is that the data is dynamic. I do not know how to identify the last row in column A (populated it with value = 2 and autofill it to the bottom of this new data in column B).
Dim EDDx As Worksheet
Dim lastrow As Long
Set EDDx = Sheets("EDD")
lastrow = EDDx.Cells(Rows.Count, "C").End(xlUp).Row
With EDDx
.Range("B45:B" & lastrow).Value = 1
End With
End Sub
Thanks
Try,
with workSheets("EDD")
.range(.cells(.rows.count, "B").end(xlup), _
.cells(.rows.count, "C").end(xlup).offset(0, -1)).filldown
end with
Try:
Option Explicit
Sub Test()
Dim LastrowC As Long
Dim LastrowB As Long
With wsTest
LastrowB = .Range("B" & Rows.Count).End(xlUp).Row
LastrowC = .Range("C" & Rows.Count).End(xlUp).Row
.Range("B" & Lastrow + 1 & ":C" & LastrowC).Value = "2"
End With
End Sub