Excel Load Data button - vba

I have a work sheet (Stored Jobs) that I have a macro that will save all the jobs data to. I am now attempting to make a macro that will reload that saved data Based On the job number entered into F9 on the MHBD work sheet the job number sits in column B. I need f to be returned as the row number that the job sits on so that I can copy data from that row into different cells on the MHBD sheet. I cant just copy the row straight because the data on the MHBD sheet is not in a row its scattered. How do I get it to return the row that the job lives on and use that to copy cells off of that row?
Sub Load_Button()
Dim StoredJobs As Worksheet
Dim MHBD As Worksheet
Dim lastRow As Long
Dim f As Range, theJob
Set StoredJobs = Worksheets("Stored Jobs")
Set MHBD = Worksheets("Manual Hour Break Down")
lastRow = StoredJobs.Range("B" & Rows.Count).End(xlUp).Row
theJob = MHBD.Range("F9").Value
'find the current job if it exists
Set f = StoredJobs.Range("B4:B" & lastRow).Find(what:=theJob, lookat:=xlWhole).Row
'if not found, use the next empty row
If f Is Nothing Then MsgBox "Job has not been entered."
End Sub

Got it. #johnColeman you were correct on removing .Row
Thanks everyone else for the ideas and help.
Sub Load_Button()
Dim StoredJobs As Worksheet
Dim MHBD As Worksheet
Dim lastRow As Long
Dim f As Range, theJob
Set StoredJobs = Worksheets("Stored Jobs")
Set MHBD = Worksheets("Manual Hours Break Down")
lastRow = StoredJobs.Range("B" & Rows.Count).End(xlUp).Row
theJob = MHBD.Range("F9").Value
'find the current job if it exists
Set f = StoredJobs.Range("B4:B" & lastRow).Find(what:=theJob, lookat:=xlWhole)
'if not found, error message
If f Is Nothing Then
MsgBox "Job: " & MHBD.Range("F9").Value & " has not been entered" & vbNewLine & "Try the Quote Number"
'if found, copy data
Else
StoredJobs.Range("C" & (f.Row)).Copy
MHBD.Range("B3").PasteSpecial xlPasteValues
End If
End Sub

Related

Clear Contents of Rows Depending on Cell Range

Data layout: A3 onwards to A(no specific last row) is referred to as under Name Manager as =PeriodPrev.
=PeriodPrev is a label that I have used to mark the data. =PeriodCurr label starts after the last populated row for PeriodPrev.
The remaining data for PeriodPrev and PeriodCurr lay under column E to W.
Code: How to I create a clear contents of data in Columns A and E to W for data belonging to =PeriodPrev in Column A?
I've tried the following code but it does not completely serves the purpose above. "If c.Value = "PeriodPrev" Then" returns error 13. "If c.Value = Range("PeriodPrev") Then" return error 1004.
Sub BYe()
'The following code is attached to the "Clear" button which deletes Previous Period data
Dim c As Range
Dim LastRow As Long
Dim ws As Worksheet
ws = ThisWorkbook.Worksheets("Sheet1")
LastRow = Range("A" & Rows.count).End(xlUp).Row
For Each c In Range("A3:A" & LastRow)
If c.Value = "PeriodPrev" Then
' If c.Value = Range("PeriodPrev") Then
c.EntireRow.ClearContents
End If
Next c
End Sub
Use Intersect
If Not Application.Intersect(c, Range(yourLabel)) Is Nothing Then
Let me know if it doesn't work
There were a few thing wrong with that code. I've tried to address some of the problems with comments
Sub BYe()
'The following code is attached to the "Clear" button which deletes Previous Period data
Dim c As Range, lastRow As Long, ws As Worksheet
'you need to SET a range or worksheet object
Set ws = ThisWorkbook.Worksheets("Sheet1")
'you've Set ws, might as well use it
With ws
lastRow = .Range("A" & Rows.Count).End(xlUp).Row
For Each c In .Range("A3:A" & lastRow)
'the Intersect determines if c is within PeriodPrev
If Not Intersect(c, .Range("PeriodPrev")) Is Nothing Then
'this clears columns A and E:W on the same row as c.
.Range(.Cells(c.Row, "A"), .Cells(c.Row, "E").Resize(1, 19)).ClearContents
End If
Next c
End With
End Sub
The following should perform the same action without the loop.
Sub BYe2()
'The following code is attached to the "Clear" button which deletes Previous Period data
Dim lastRow As Long, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
With ws
lastRow = .Range("PeriodPrev").Rows(.Range("PeriodPrev").Rows.Count).Row
.Range("A3:A" & lastRow & ",E3:W" & lastRow).ClearContents
End With
End Sub

Create a summary sheet based on multiple worksheets

I have number of worksheets containing the same structure and same number of rows. Now I would like to create a master sheet to have an overview of all the worksheets using VBA.
It is like a balance sheet showing the performance over several years, which Years are on the headings and items are on rows.
Now the yearly data are put on multiple worksheets named "2012", "2013" and "2014".
Column B on sheet 1 ("2012") will be copied onto col B on "master" but for the following sheets ("2013", "2014"), data will be placed onto the next column on "master" (ie 2013 data on col C, 2014 data on col D).
I would like to have a workable macro which can count numbers of worksheets and copy paste specific data on a right column of master sheet.
1) create in a sheet a table like that: where the first column is where the destination cell in your Master report. And the 2nd column is where the data will be copied.
2) Put all your Worksheets in a folder
3) Run this macro, which need to be placed in Master module
Option Explicit
'assuming that:
'- "Excel Column Code" is in column A
'- "Form Cell Code" is in column B
'in zmaster.xlsm!Sheet2
Sub UpdateData()
Dim sFile As String, sPath As String
Dim srcWbk As Workbook, dstWbk As Workbook
Dim srcWsh As Worksheet, dstWsh As Worksheet, infoWsh As Worksheet
Dim i As Long, j As Long, k As Long
On Error GoTo Err_UpdateData
Set dstWbk = ThisWorkbook
Set dstWsh = dstWbk.Worksheets("Sheet1")
Set infoWsh = dstWbk.Worksheets("Sheet2")
sPath = "C:\Desktop\New folder\"
sFile = Dir(sPath)
Do While Len(sFile) > 0
If sFile = "zmaster.xlsm" Then
GoTo SkipNext
End If
Set srcWbk = Workbooks.Open(sPath & sFile)
Set srcWsh = srcWbk.Worksheets(1)
i = 2
'loop through the information about copy-paste method
Do While infoWsh.Range("A" & i) <> ""
'get first empty row, use "Excel Column Code" to get column name
j = GetFirstEmpty(dstWsh, infoWsh.Range("A" & i))
'copy data from source sheet to the destination sheet
'use "Form Cell Code" to define destination cell
srcWsh.Range(infoWsh.Range("B" & i)).Copy dstWsh.Range(infoWsh.Range("A" & i) & j)
i = i + 1
Loop
srcwbk.Close SaveChanges:=False
SkipNext:
sFile = Dir
Loop
Exit_UpdateData:
On Error Resume Next
Set srcWsh = Nothing
Set dstWsh = Nothing
Set srcWbk = Nothing
Set dstWbk = Nothing
Exit Sub
Err_UpdateData:
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_UpdateData
End Sub
'returns first empty row in a destination sheet based on column name
Function GetFirstEmpty(ByVal wsh As Worksheet, Optional ByVal sCol As String = "A") As Long
GetFirstEmpty = wsh.Range(sCol & wsh.Rows.Count).End(xlUp).Row + 1
End Function

I need to create new sheets based on unique names found in column A. Current Code generates excess data in certain sheets

I have the following code so far based on questions asked by other people.
I have a set of names listed in column A, and 216 columns and 9725 rows of data.
Currently using the following code I get the new sheets created except along with the unique names and its relevant data I get many cells filled with "#N/A".
In certain cases, the name Bob for example will be populated in a new sheet called Bob but the first column will have Bob and all relevant data and once all Bobs rows are shown it is follower with many rows with #N/A and all columns with #N/A.
In other cases the sheet will be created for Charles and all of Charles data will be listed, then many rows of #N/A and then all of the master-data including other peoples names which I need to avoid.
I want each individual sheet to only have the info based on the name of the person on that sheet. All of the data gets copied as I verified the number of accurate cells that get populated yet I get these #N/A cells and duplicated extra data and I'm not sure how to stop it from being populated? Any help in cleaning the code would be appreciated!!
Code:
Sub CopyDataFromReportToIndividualSheets()
Dim ws As Worksheet
Set ws = Sheets("FormulaMSheet2")
Dim LastRow As Long
Dim MyRange As Range
Worksheets("FormulaMSheet2").Activate
LastRow = Range("A" & ws.Rows.Count).End(xlUp).Row
' stop processing if we don't have any data
If LastRow < 2 Then Exit Sub
Application.ScreenUpdating = False
' SortMasterList LastRow, ws
CopyDataToSheets LastRow, ws
ws.Select
Application.ScreenUpdating = True
End Sub
Sub SortMasterList(LastRow As Long, ws As Worksheet)
ws.Range("A2:BO" & LastRow).Sort Key1:=ws.Range("A1")
', Key2:=ws.Range("B1")
End Sub
Sub CopyDataToSheets(LastRow As Long, src As Worksheet)
Dim allAgentNameCells As Range
Dim cell As Range
Dim Series As String
Dim SeriesStart As Long
Dim SeriesLast As Long
Set allAgentNameCells = Range("A2:A" & LastRow)
SeriesStart = 2
Series = Range("A" & SeriesStart).Value
For Each cell In allAgentNameCells
If cell.Value <> " " And cell.Value <> "" Then
' Condition ` And cell.Value <> "" ` added for my testdata. If you don't need this, please remove.
' Current Row's Series not SPACE
If cell.Value <> Series Then
SeriesLast = cell.Row - 1
CopySeriesToNewSheet src, SeriesStart, SeriesLast, Series
Series = cell.Value
SeriesStart = cell.Row
End If
End If
Next
'' copy the last series
SeriesLast = LastRow
CopySeriesToNewSheet src, SeriesStart, SeriesLast, Series
End Sub
Sub CopySeriesToNewSheet(src As Worksheet, Start As Long, Last As Long, name As String)
Dim tgt As Worksheet
Dim MyRange As Range
If (SheetExists(name)) Then
MsgBox "Sheet " & name & " already exists. " _
& "Please delete or move existing sheets before" _
& " copying data from the Master List.", vbCritical, _
"Time Series Parser"
End
Else
If Series = " " Then
End
End If
End If
Worksheets("FormulaMSheet2").Activate
' Worksheets.Add(after:=Worksheets(Worksheets.Count)).name = name
Worksheets("FormulaMSheet2").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.name = name
Set tgt = Sheets(name)
' copy data from src to tgt
tgt.Range("A2:BO2" & Last - Start + 2).Value = src.Range("A" & Start & ":BO" & Last).Value
End Sub
Function SheetExists(name As String) As Boolean
Dim ws As Variant
For Each ws In ThisWorkbook.Sheets
If ws.name = name Then
SheetExists = True
Exit Function
End If
Next
SheetExists = False
End Function
You need replace the
tgt.Range("A2:BO2" & Last - Start + 2).Value = src.Range("A" & Start & ":BO" & Last).Value
to
src.Range("A" & Start & ":BO" & Last).SpecialCells(xlCellTypeVisible).Copy Destination:=tgt.Range("A2:BO2" & Last - Start + 2)
I found what I needed at the following site: http://www.rondebruin.nl/win/s3/win006_5.htm .
I figured if anyone else was looking for similar code it would help taking a look at the site.

Copy/Paste multiple rows in VBA

I am attempting to do a simple copy row, paste row within a workbook. I've searched threads and tried changing my code multiple times to no avail.
The one that comes closest to working is this but it only copies a single instance of matching criteria.
I am trying to create a loop that will copy all of the rows that has a match in one of the columns.
So, if 8 columns, each row with matching value in column 7 should copy to a named sheet.
Sub test()
Set MR = Sheets("Main").Range("H1:H1000")
Dim WOLastRow As Long, Iter As Long
For Each cell In MR
If cell.Value = "X" Then
cell.EntireRow.Copy
Sheets("X").Range("A" & Rows.Count).End(xlUp).PasteSpecial
End If
If cell.Value = "Y" Then
cell.EntireRow.Copy
Sheets("Y").Range("A" & Rows.Count).End(xlUp).PasteSpecial
End If
If cell.Value = "Z" Then
cell.EntireRow.Copy
Sheets("Z").Range("A" & Rows.Count).End(xlUp).PasteSpecial
End If
If cell.Value = "AB" Then
cell.EntireRow.Copy
Sheets("AB").Range("A" & Rows.Count).End(xlUp).PasteSpecial
End If
Application.CutCopyMode = False
Next
End Sub
I like this because I need to target multiple destination sheets with different criteria but I need all rows that match criteria to copy over.
EDITED CODE IN RESPONSE TO NEW REQUEST:
The code below will copy all of the rows in Sheet Main and paste them into the corresponding worksheets based on the value in Column 7.
Do note: If there is a value in Column 7 that does NOT match to an existing sheet name, the code will throw an error. Modify the code to handle that exception.
Let me know of any additional needed help.
Sub CopyStuff()
Dim wsMain As Worksheet
Dim wsPaste As Worksheet
Dim rngCopy As Range
Dim nLastRow As Long
Dim nPasteRow As Long
Dim rngCell As Range
Dim ws As Worksheet
Const COLUMN_TO_LOOP As Integer = 7
Application.ScreenUpdating = False
Set wsMain = Worksheets("Main")
nLastRow = wsMain.Cells(Rows.Count, 1).End(xlUp).Row
Set rngCopy = wsMain.Range("A2:H" & nLastRow)
For Each ws In ActiveWorkbook.Worksheets
If UCase(ws.Name) = "MAIN" Then
'Do Nothing for now
Else
Intersect(ws.UsedRange, ws.Columns("A:H")).ClearContents
End If
Next ws
For Each rngCell In Intersect(rngCopy, Columns(COLUMN_TO_LOOP))
On Error Resume Next
Set wsPaste = Worksheets(rngCell.Value)
On Error GoTo 0
If wsPaste Is Nothing Then
MsgBox ("Sheet name: " & rngCell.Value & " does not exist")
Else
nPasteRow = wsPaste.Cells(Rows.Count, 1).End(xlUp).Row + 1
wsMain.Range("A" & rngCell.Row).Resize(, 8).Copy wsPaste.Cells(nPasteRow, 1)
End If
Set wsPaste = Nothing
Next rngCell
Application.ScreenUpdating = True
End Sub
Your current code is pasting to the same row in each sheet over and over, to the last row with a value in column A. Range("A" & Rows.Count).End(xlUp) says, roughly "go to the very bottom of the spreadsheet in column A, and then jump up from there to the next lowest cell in column A with contents," which gets you back to the same cell each time.
Instead, you could use lines of the pattern:
Sheets("X").Range("A" & Sheets("X").UsedRange.Rows.Count + 1).PasteSpecial
Where UsedRange is a range containing all of the cells on the sheet with data in them. The + 1 puts you on the following row.
You could make this a little prettier using With:
With Sheets("X")
.Range("A" & .UsedRange.Rows.Count + 1).PasteSpecial
End With

Using VBA - Insert VLOOKUP depending on certain values

I am trying to retrieve data from another file using the VLOOKUP function however this is only to happen depending on if any of the 3 items of data appear in column 8(H)
OLY
OLY - QUO
OLY - PRO
I have the following and know this is not correct
Sub BlockAllocationsVlookupAll()
Dim x As Long
For x = 1 To 65536
If InStr(1, Sheet1.Range("$H$" & x), "OLY") > 0 Then
Sheet1.Range("$I$" & x) = Sheet1.Range("$I$" & x) & "sometext"
End If
Next
End Sub
I know the above doesn't do exactly what I need can anyone help as to what needs to be edited to include the Vlookup below
=VLOOKUP(A21,'[001 - Allocations - Blocks.xls]CurrentDayAll'!$1:$65536,9,FALSE)
The other issue is that the cell the VLOOKUP points to first will also change due to the varying length of the report
Thank you for any help given
UPD:
As follows up from comments,
column H is in Allocations.xls workbook
there are a set of criterias
formula should be placed in cell only if corresponding cell in column H matches any of thouse criterias.
Working code:
Sub BlockAllocationsVlookupAll()
Dim x As Long
Dim lastrow As Long
Dim searchCriterias As String
Dim wb As Workbook
Dim ws As Worksheet
'specify correct path to your workbook
Set wb = Workbooks.Open("C:\Allocations.xls")
'If workbook is already opened use next line
'Set wb = Workbooks("Allocations.xls")
Set ws = wb.Worksheets("Current Day")
searchCriterias = "|OLY|SVC|SVC-PRO|SVC-QUO|EUR|EUR-PRO|EUR-QUO|"
With ws
lastrow = .Cells(.Rows.Count, "H").End(xlUp).Row
For x = 4 To lastrow
If InStr(1, searchCriterias, "|" & .Range("H" & x) & "|") > 0 Then
.Range("I" & x).Formula = "=VLOOKUP(A" & x & ",'[001 - Allocations - Blocks.xls]CurrentDayAll'!$A:$I,9,FALSE)"
End If
Next
End With
'Comment next line if you don't want to close wb
wb.Close (True)
Set wb = Nothing
End Sub