Need to change a macro so that it transposes and fills rows instread of columns - vba

I am running a macro that copies, finds next available column along and then pastes as values.
After reluctantly continuing to do it in columns I have realized how much it easier it will be to have it vertically stored - data is pulled in every hour so having it in columns is making summarizing a lot of effort.
The macro below finds the next available column and then pastes next to it. I have tried to change it so that it will transpose paste with the date alongside the row in column A for example, but I am struggling to work it out.
Any help would be appreciated thanks a lot.
Sub HistoricalDataNewOne()
Dim TargetSht As Worksheet, SourceSht As Worksheet, SourceCol As Integer, SourceCells As Range
'If an error occurs skip code to the Err-Hanlder line and the display the error message.
On Error GoTo Err_Handler
'This is the sheet where your copy information from. Change "Sheet1" to the name of your soure sheet
Set SourceSht = ThisWorkbook.Sheets("BARGE LIVE TRACKING")
'Name of the sheet where data is to be copied to. Rename Sheet2 to the name of your target sheet
Set TargetSht = ThisWorkbook.Sheets("Detailed Tracking")
'This is the cells you will copy data from. This is targeting cells B1 to the last used cell in column B
Set SourceCells = SourceSht.Range("g3:h" & SourceSht.Range("J65536").End(xlUp).Row)
'This is finding the next column available in the target sheet. It assumes dates will be in row 1 and data in row 2 down
If TargetSht.Range("A1").Value = "" Then
'Cell A1 is blank so the column to put data in will be column #1 (ie A)
SourceCol = 1
ElseIf TargetSht.Range("IV1").Value <> "" Then
'Cell IV1 has something in it so we have reached the maximum number of columns we can use in this sheet.
'Dont paste the data but advise'
MsgBox "There are no more columns available in the sheet " & TargetSht.Name, vbCritical, "No More Data Can Be Copied"
'stop the macro at this point
Exit Sub
Else
'cell A1 does have data and we havent reached the last column yet so find the next available column
SourceCol = TargetSht.Range("IV1").End(xlToLeft).Column + 2
End If
'Put in the date in the appropriate column in row 1 of the target sheet
TargetSht.Cells(1, SourceCol).Value = Format(Now, "HH:MM DD/MMM")
'We can now start copying data. This will copy the cells in column B from the source sheet to row 2+ in the target sheet
SourceCells.Copy
TargetSht.Cells(2, SourceCol).PasteSpecial xlPasteValues
Exit Sub 'This is to stop the procedure so we dont display the error message every time.
Err_Handler:
MsgBox "The following error occured:" & vbLf & "Error #: " & Err.Number & vbLf & "Description: " & Err.Description, _
vbCritical, "An Error Has Occured", Err.HelpFile, Err.HelpContext
End Sub

These amendments to the last part should do:
Sub HistoricalDataNewOne()
Dim TargetSht As Worksheet, SourceSht As Worksheet, SourceCells As Range
'If an error occurs skip code to the Err-Hanlder line and the display the error message.
On Error GoTo Err_Handler
'This is the sheet where your copy information from. Change "Sheet1" to the name of your soure sheet
Set SourceSht = ThisWorkbook.Sheets("BARGE LIVE TRACKING")
'Name of the sheet where data is to be copied to. Rename Sheet2 to the name of your target sheet
Set TargetSht = ThisWorkbook.Sheets("Detailed Tracking")
'This is the cells you will copy data from. This is targeting cells B1 to the last used cell in column B
Set SourceCells = SourceSht.Range("g3:h" & SourceSht.Range("J65536").End(xlUp).Row)
''''''''''''''''''''''''''''''
' No changes so far
' Now the changes:
''''''''''''''''''''''''''''''
Dim dstRow As Long: dstRow = TargetSht.Range("A1000000").End(xlUp).Row + 2
'Put in the date in the appropriate row columns A 1 of the target sheet
TargetSht.Cells(dstRow, 1).Value = Format(Now, "HH:MM DD/MMM")
TargetSht.Cells(dstRow, 2).Resize(SourceCells.Columns.Count, SourceCells.Rows.Count).Value2 = _
Application.Transpose(SourceCells.Value2)
Exit Sub 'This is to stop the procedure so we dont display the error message every time.
Err_Handler:
MsgBox "The following error occured:" & vbLf & "Error #: " & Err.Number & vbLf & "Description: " & Err.Description, _
vbCritical, "An Error Has Occured", Err.HelpFile, Err.HelpContext
End Sub

Related

Copy and paste a range of cells where the range changes each time the data is refreshed

I have a spreadsheet where data is refreshed each day. I want to copy and paste the data into an archive sheet. I have managed to do this with selecting a specific range of cells but the issue is that the range of cells will change each day.
Sub Archive_Data()
Dim mainworkbook As Workbook
Set mainworkbook = ActiveWorkbook
mainworkbook.Sheets("Status Report (Execution)").Range("B17:AB56").Copy
mainworkbook.Sheets("Archive Execution").Paste
End Sub
This code selects all of the data and pastes it but it is not exactly what I'm looking for.
Lets summarize - your problem is that you have to locate the last column and the last row of your range, because these are changing daily. Once you have these, you have your range.
Here you can get some ideas for locating the last row.
How to determine the last Row used in VBA including blank spaces in between
The logic for the last column is really similar.
You can use a named range. (Highlight range of cells, right-click, Define name...) If rows or columns are added within the range, the range boundaries are automatically updated.
Then, in your code,
Dim rangeName
rangeName = "Status Report" 'Or whatever name you gave the range.
Application.Goto Reference:=rangeName 'This will also select the range of cells.
selection.Copy
mainworkbook.Sheets("Archive Execution").Paste
You can also create a named range for the destination if you want to put the copied cells in a specific location on the target page. Here are some subroutines that may help you.
Public Sub test()
Call Copy_Detail_Rows("Sheet1", "Sheet2", "Status_Report")
End Sub
Private Sub Copy_Detail_Rows(sourceWorksheet, targetWorksheet, rangeName)
'
' Copy_Detail_Rows Macro
' Copy the detail rows using rangeName from the source worksheet to the target worksheet.
' See Formulas tab, Name Manager to manage named ranges.
'
'First, check to ensure that the source and target worksheets exist.
On Error GoTo SourceWorksheetErrorHandler
Sheets(sourceWorksheet).Select 'Go to the source worksheet.
On Error GoTo 0 'Reset default error handling.
On Error GoTo TargetWorksheetErrorHandler
Sheets(targetWorksheet).Select 'Go to the target worksheet.
On Error GoTo 0 'Reset default error handling.
'Delete any existing data in the target range.
On Error GoTo TargetReferenceErrorHandler
Application.Goto Reference:=rangeName 'This will also select the range of cells.
On Error GoTo 0 'Reset default error handling.
selection.ClearContents 'Cannot use Selection.Delete because it will wipe out the rangeName.
Sheets(sourceWorksheet).Select 'Go to the source worksheet.
On Error GoTo SourceReferenceErrorHandler
Application.Goto Reference:=rangeName 'This will also select the range of cells.
On Error GoTo 0 'Reset default error handling.
selection.Copy
Sheets(targetWorksheet).Select 'Go to the target worksheet.
On Error GoTo TargetReferenceErrorHandler
Application.Goto Reference:=rangeName 'This will also select the range of cells.
On Error GoTo 0 'Reset default error handling.
selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Exit Sub 'Skip the error handlers below.
SourceWorksheetErrorHandler:
On Error GoTo 0 'Reset default error handling.
Call WorksheetErrorHandlerMessage(sourceWorksheet, "copied from")
Err.Raise 1001, "Module1::Copy_Detail_Rows()", "Unable to locate the source worksheet."
'Uncomment one of the following lines as needed.
'Resume 0 'Resumes with line that caused the error.
'Resume Next 'Resumes with line following the line which caused the error.
'Resume <line number or label> 'Resumes with line number or label provided.
Exit Sub
TargetWorksheetErrorHandler:
On Error GoTo 0 'Reset default error handling.
Call WorksheetErrorHandlerMessage(targetWorksheet, "copied to")
Err.Raise 1002, "Module1::Copy_Detail_Rows()", "Unable to locate the target worksheet."
Exit Sub
SourceReferenceErrorHandler:
On Error GoTo 0 'Reset default error handling.
Call ReferenceErrorHandlerMessage(sourceWorksheet, rangeName, "copied from")
Err.Raise 1003, "Module1::Copy_Detail_Rows()", "Unable to locate the source range."
Exit Sub
TargetReferenceErrorHandler:
On Error GoTo 0 'Reset default error handling.
Call ReferenceErrorHandlerMessage(targetWorksheet, rangeName, "copied to")
Err.Raise 1004, "Module1::Copy_Detail_Rows()", "Unable to locate the target range."
Exit Sub
End Sub
Private Sub WorksheetErrorHandlerMessage(worksheetName, operation)
MsgBox ("Cannot locate the worksheet: " & worksheetName & "." & vbCrLf & vbCrLf _
& "Please select the worksheet where you want the detail rows " & operation _
& " and name it: " & worksheetName & "." & vbCrLf & vbCrLf _
& "Select the range of cells to be used for copy operation and run the macro, " _
& "Create_Range_Name_For_Current_Selection." & vbCrLf & vbCrLf _
& "Then you can re-run this macro. (Press Alt-F8 to view the macro menu.)" & vbCrLf & vbCrLf _
& "Note: The range selection on the source worksheet can be multiple groups of cells, " _
& "but the destination range on the target should be a single cell or row." _
)
End Sub
Private Sub ReferenceErrorHandlerMessage(worksheetName, rangeName, operation)
MsgBox ("Cannot locate the range: " & rangeName & " on sheet: " & worksheetName & "." & vbCrLf & vbCrLf _
& "Please select the cell(s) where you want the detail rows " & operation & " and run the macro, " _
& "Create_Range_Name_For_Current_Selection." & vbCrLf & vbCrLf _
& "Then you can re-run this macro. (Press Alt-F8 to view the macro menu.)" & vbCrLf & vbCrLf _
& "Note: The range selection can be multiple groups of cells." _
)
End Sub
Private Sub ShowSelectionAttributes()
'If the selection is not contiguous, the row count and column count are from the first block of cells.
MsgBox ("Current selection: " & vbCrLf _
& " Address = " & selection.address() & vbCrLf _
& " AddressLocal = " & selection.AddressLocal() & vbCrLf _
& " Cells.Count = " & selection.Cells.Count() & vbCrLf _
& " Rows.Count = " & selection.Rows.Count() & vbCrLf _
& " Columns.Count = " & selection.Columns.Count() & vbCrLf _
& " First row number = " & selection.row & vbCrLf _
& " Last row number (calculated) = " & (selection.Rows.Count() + selection.row - 1) & vbCrLf _
& " Last row number (from range) = " & Get_Last_Row_Number_From(selection) & vbCrLf _
& " ActiveSheet.Name = " & ActiveSheet.Name() _
)
End Sub
Sub Create_Range_Name_For_Current_Selection()
'
' Create the named range based on the current cell selection.
' This does not need to be a contiguous group of cells - it can be
' multiple groups of cells anywhere on the page.
Dim rangeName
rangeName = "Status_Report" 'Consider using a global variable for this.
'Call ShowSelectionAttributes 'Displays a message box. Uncomment this if you want to see some of the attributes.
On Error Resume Next
ActiveSheet.Names(rangeName).Delete 'This just deletes the name, not the data in the range.
On Error GoTo 0 'Reset error handler.
'The RefersTo targetWorksheet name needs to be enclosed in single quotes in case it contains spaces.
ActiveSheet.Names.Add Name:=rangeName, _
RefersTo:="='" & ActiveSheet.Name() & "'!" & selection.address()
'Use the RefersTo format above to pass Row and Column names e.g. "$A$7:$L$340" (Note $ is absolute - w/o $ is relative)
'Use the RefersToR1C1 format below to pass Row and Column number (default format when recording a macro).
'ActiveWorkbook.Worksheets("Macro_Test").Names.Add Name:="Status_Report_Detail_Rows", _
' RefersToR1C1:="=Macro_Test!R7C1:R340C12"
End Sub
Function Get_Column_Number_For(aColumnName)
'Utility function for converting column names to the corresponding numbers.
'In the Immediate window, ?Get_Column_Number_For("AZ") should return 52.
Get_Column_Number_For = Range(aColumnName & 1).Column 'Get column number from the cell at aColumnName and row number 1.
End Function
Function Get_Column_Name_For(aColumnNumber)
'Return the column name (letter(s)) corresponding to this column number.
'Use the cell at row 1, aColumnNumber to get the column name.
'In the Immediate window, ?Get_Column_Name_For(52) should return AZ.
Get_Column_Name_For = Get_First_Column_Name_From(Cells(1, aColumnNumber))
End Function
Function Get_First_Column_Name_From(aRange)
'Return the column name (letter(s)) from the first cell in aRange.
'The range does not need to be contiguous. It can also be a single cell. Note that the first
'cell in a range may not be the furthest cell to the left. Cells selected by using the Ctrl key
'are listed in the order of selection.
'Get the column name for the current selection by calling Get_First_Column_Name_From(selection)
Get_First_Column_Name_From = Get_First_Column_Name_From_Address(Cells(aRange.row, aRange.Column).address)
End Function
Function Get_First_Column_Name_From_Address(aRangeAddress)
Get_First_Column_Name_From_Address = Split(aRangeAddress, "$")(1) 'Get the first element of the array.
End Function
Function Get_Last_Column_Name_From(aRange)
Get_Last_Column_Name_From = Get_Last_Column_Name_From_Address(aRange.address)
End Function
Function Get_Last_Column_Name_From_Address(aRangeAddress)
'Return the column name (letter(s)) from the last cell in aRange.
'The range does not need to be contiguous. It can also be a single cell. Note that the last
'cell in a range may not be the furthest cell to the right. Cells selected by using the Ctrl key
'are listed in the order of selection.
'Get the column name for the current selection by calling Get_Last_Column_Name_From(selection)
Dim rangeArray() As String
Dim rangeCount As Integer
Dim lastRangeGroup As String
Dim lastCellAddress As String
rangeArray = Split(aRangeAddress, ",") 'aRange can contain multiple groups separated by commas.
rangeCount = UBound(rangeArray)
lastRangeGroup = rangeArray(rangeCount)
rangeArray = Split(lastRangeGroup, ":") 'Split the last group on the colon (:) if it exists.
rangeCount = UBound(rangeArray)
lastCellAddress = rangeArray(rangeCount)
Get_Last_Column_Name_From_Address = Split(lastCellAddress, "$")(1) 'Get the first element of the array.
End Function
Function Get_First_Row_Number_From(aRange)
'Returns the row number as a string.
Get_First_Row_Number_From = aRange.row
End Function
Function Get_Last_Row_Number_From(aRange)
'Returns the row number as a string.
Get_Last_Row_Number_From = Get_Last_Row_Number_From_Address(aRange.address)
End Function
Function Get_Last_Row_Number_From_Address(aRangeAddress)
'Returns the row number as a string.
'We can't just add the first row to the row count because the range may not be contiguous.
'If the selection is not contiguous, the row count and column count are from the first block of cells.
'See http://msdn.microsoft.com/en-us/library/office/ff195745(v=office.15).aspx for info on Areas.Count.
'Return the number from the last cell in aRange.
'The range does not need to be contiguous. It can also be a single cell. Note that the last
'cell in a range may not be the furthest cell to the bottom/right. Cells selected by using the Ctrl key
'are listed in the order of selection.
'Get the last row number for the current selection by calling Get_Last_Row_Number_From(selection)
Dim rangeArray() As String
Dim rangeCount As Integer
Dim lastRangeGroup As String
Dim lastCellAddress As String
rangeArray = Split(aRangeAddress, ",") 'aRange can contain multiple groups separated by commas.
rangeCount = UBound(rangeArray)
lastRangeGroup = rangeArray(rangeCount)
rangeArray = Split(lastRangeGroup, ":") 'Split the last group on the colon (:) if it exists.
rangeCount = UBound(rangeArray)
lastCellAddress = rangeArray(rangeCount)
Get_Last_Row_Number_From_Address = Split(lastCellAddress, "$")(2) 'Get the second element of the array.
'Note: It's really the third element because
'there are two $ signs and it's a zero-based index.
End Function

How to pause macro, then do my stuff and continue/resume from where I left?

I got data in one sheet form B2:ZY191, and I want to copy each row (B2:ZY2,B3:ZY3, and so on till B191:ZY191) to another workbook worksheet for analysis. Now while doing so I sometimes need to stop and mark my results in between and then continue from where I left. For example, I started the macro and it copied from B2:ZY2 to B52:ZY52 then I pause the macro & mark my results. Now I want to continue from B52:ZY52 onwards then again if I want to stop after copying data till B95:ZY95 I should be able to pause the macro, mark my result and continue from B95:ZY95 thereon. I should be able to do this as many times as I want.
If provided with buttons like start, pause and resume would be very helpful.
you could adopt the following workaround:
choose the "sets" you want to virtually divide your data range into
let's say:
set#1 = rows 1 to 20
set#2 = rows 21 to 30
... and so on
mark with any character in column "A" the final rows of all chosen sets
so you'd put a "1" (or any other character other than "|I|" or "|E|" - see below) in the following cells of column "A" (i.e. the one preceding your data range):
A21
A31
..., and so on
(since your data starts at row 2 then its ith row is in worksheet row I+1)
then you put the following code in any module of your data range workbook:
Option Explicit
Sub DoThings()
Dim dataRng As Range, rngToCopy As Range
'assuming Analysis.xlsx is already open
Set dataRng = Worksheets("BZ").Range("B2:ZY191") '<--| this is the whole data range. you can change it (both worksheet name and range address) but be sure to have a free column preceeding it
Set rngToCopy = GetCurrentRange(dataRng) '<--| try and set the next "set" range to copy
If rngToCopy Is Nothing Then '<--| if no "set" range has been found...inform the user and exit sub!
MsgBox "There's an '|E|' at cell " _
& vbCrLf & vbCrLf & vbTab & dataRng(dataRng.Rows.Count, 1).Offset(, -1).Address _
& vbCrLf & vbCrLf & " marking data has already been entirely copied" _
& vbCrLf & vbCrLf & vbCrLf & "Remove it if you want to start anew", vbInformation
Exit Sub
End If
With rngToCopy
Workbooks("Analysis").Worksheets("Sheet1").Range(.Address).value = .value
End With
End Sub
Function GetCurrentRange(dataRng As Range) As Range
Dim f As Range
Dim iniRow As Long, endRow As Long
With dataRng
With .Offset(, -1)
Set f = .Resize(, 1).Find(what:="|E|", lookat:=xlWhole, LookIn:=xlValues) '<--| look for the "all copied" mark ("|E|")
If Not f Is Nothing Then Exit Function '<--| if "all copied" mark was there then exit function
Set f = .Resize(, 1).Find(what:="|I|", lookat:=xlWhole, LookIn:=xlValues) '<--| look for any "initial" mark put by a preceeding sub run
If f Is Nothing Then '<--|if there was no "initial" mark ...
iniRow = 1 '<--| ...then assume first row as initial one
Else
iniRow = f.row - .Cells(1).row + 1 '<--| ... otherwise assume "marked" row as initial one
f.ClearContents '<--| and clear it not to found it the next time
End If
endRow = .Cells(iniRow, 1).End(xlDown).row - .Cells(1).row + 1 '<--| set the last row as the next one with any making in column "A"
If endRow >= .Rows.Count Then '<--| if no mark has been found...
endRow = .Rows.Count '<--| ...set the last row as data last row...
.Cells(endRow, 1).value = "|E|" '<--|... and put the "all copied" mark in it
Else
.Cells(endRow, 1).ClearContents '<--| ...otherwise clear it...
.Cells(endRow + 1, 1).value = "|I|" '<--| ... and mark the next one as initial for a subsequent run
End If
End With
Set GetCurrentRange = .Rows(iniRow).Resize(endRow - iniRow + 1) '<--| finally, set the range to be copied
End With
End Function
and make it run as many times as you need: after each time it ends and you can mark your result and then make it run again and it'll restart form where it left
you can use Stop and Debug.Print to achieve the desired results when placed within your code. For example if you're looping through a range, add the statement of choice with an if statement:
for a = 1 to 150
if a = 20 or a = 40 then
debug.Print "The value of a is: " & a.value 'or whatever you want to see
end if
next
This will print to the immediates window, or use stop to pause your code in a strategic place in the same manner.
I dont understand what you mean by buttons? They surely aren't a good idea as the code will run too fast?

Look up values in sheet(x) column(x), match to values in sheet(y) column(y), if they match paste row

Dealing with an issue that seems simple enough, but for some reason I cannot get this to work.
I have a data input sheet I am trying to match values across to another sheet, the values are both in column E, and all the values in column E are unique.
The values will always be stored in rows 8 though to 2500.
My code is as below, however is throwing the ever useful 1004 error (Application-Defined or object-defined error), on line
If Sheets("Target Inputs").Range("E" & CStr(LSearchRow)).Value = searchTerm Then
any help would be greatly appreciated:
Sub LOAD_BUID_Lookup()
Dim i As Integer
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim searchTerm As String
On Error GoTo Err_Execute
For i = 8 To 2500
searchTerm = Range("E" & i).Text
If Sheets("Target Inputs").Range("E" & CStr(LSearchRow)).Value = searchTerm Then
'Select row in Sheet1 to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into Sheet2 in next row
Sheets("LOAD").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
'Move counter to next row
LCopyToRow = LCopyToRow + 1
'Go back to Sheet1 to continue searching
Sheets("Target Inputs").Select
End If
Next i
Application.CutCopyMode = False
Range("A3").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
LSearchRow is not being set to any value, which means it is 0. This in turn throws the exception, since the row number cannot be 0. And there is no reason whatsoever to convert to string with CStr, since the concatenation casts the entire range parameter to a string anyway.
Usually when comparing two different columns in two different sheet you would see a double loop the first to loop through sheet1 and the second to take every value of sheet1 and loop through sheet2 to find a match. In reading your description I think this is what you want.
Double loops can be time intensive. There is another way, Worksheetfunction.match!!
I also noticed your code selecting/activating sheets multiple times. Typically selecting/activating sheets is not required if you declare and instantiate the variables you need.
Below is an example code I tried to make it as plug and play as possible, but I wasn't sure of the name of the sheet you are looping through. I've tested the code on dummy data and it seems to work, but again I'm not quite positive on the application. I've commented the code to explain as much of the process as possible. Hopefully it helps. Cheers!
Option Explicit 'keeps simple errors from happening
Sub LOAD_BUID_Lookup()
'Declare variables
Dim wb As Workbook
Dim wsInputs As Worksheet
Dim wsTarget As Worksheet
Dim wsLoad As Worksheet
Dim searchTerm As String
Dim matchRng As Range
Dim res
Dim i As Integer
'instantiate variables
Set wb = Application.ThisWorkbook
Set wsInputs = wb.Worksheets("Inputs") 'unsure of the name of this sheet
Set wsTarget = wb.Worksheets("Target Inputs")
Set wsLoad = wb.Worksheets("LOAD")
Set matchRng = wsTarget.Range("E:E")
On Error GoTo Err_Execute
For i = 8 To 2500
searchTerm = wsInputs.Range("E" & i).Text 'can use sheet variable to refer exactly to the sheet you want without selecting
'get match if one exists
On Error Resume Next
res = Application.WorksheetFunction.Match(searchTerm, matchRng, 0) 'will return a row number if there is a match
If Err.Number > 0 Then 'the above command will throw an error if there is no match
'MsgBox "No Match!", vbCritical
Err.Clear ' we clear the error for next time around
On Error GoTo 0 'return to previous error handeling
Else
On Error GoTo 0 'return to previous error handeling
wsInputs.Range("A" & i).EntireRow.Copy Destination:=wsLoad.Range("A" & wsLoad.Range("E50000").End(xlUp).Row + 1) 'gets last row and comes up to last used row ... offset goes one down from that to the next empty row
End If
Next i
'Application.CutCopyMode = False -- there is no need for this when we use "Destination"
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub

Excel VBA: copy cell "address" message content to a new sheet

I have this code that will locate the blank cells in Column A and will highlight them in red. Then, a msgbox will display the location of the blank cells using "Address". For example it will show: "No Value, in $A$15".
Sub CeldassinData()
Dim i As Long, r As Range, coltoSearch As String
coltoSearch = "A"
For i = 1 To Range(coltoSearch & Rows.Count).End(xlUp).Row
Set r = Range(coltoSearch & i)
If Len(r.Value) = 0 Then
r.Interior.ColorIndex = 3 ' Red
r.Select
MsgBox "No Value, in " & r.Address
End If
Next
End Sub
I need help with:
For each message that will pop and find a blank cell, I want to copy, for example, the value "$A$15" shown in the message and paste it in the Column A of another sheet in the same workbook.
I would really appreciate it if someone helps me with this. Thank you in advance.
After the msgbox put this:
Sheets("Log").Range("A" & Sheets("Log").Range("A" & rows.count).end(xlup).Row).offset(1,0).formula = r.Address
Make sure you have a sheet in there called Log and it will populate

Creating excel macro to take info from form and append it onto bottom of list

I am currently working on a spreadsheet to help track individuals who attend a weekly meeting conducted by my department. I am trying to automate the process of tracking by using a macro to copy values from a list/form that a member of my department will enter the attendees email and the date. The email and date will then be added together (=a&b) to generate a value and that value will be used to mark whether the individual is present or not at that particular meeting. View Image of form/table
A report is generated after the meeting to tell which individuals have attended and how long they were on the call for. Before I was taking this report and pasting it onto the bottom of the original list but this has become inefficient as the columns and table length have changed. What I would like to do is take the emails, dates, and value on spreadsheet from the calculate tab and have those values append onto the bottom of the list on the reports tab without altering any of the previous information. View Image of reports tab
After the values have been appended to the bottom of the report, I have another tab called meeting dates. This contains a formula that will determine whether the individual was present or not by marking it with either ā€œYā€ or ā€œNā€. Forgot to mention that every week it is the same 17 individuals that are attending these meetings. Eventually I would like to have it so that if the date entered on the calculate tab is not present on the meeting dates tab, add the date to the meeting dates tab.
I am still very new to Excel VB and macros however do have some programming experience. Just not in excel. If somebody could help me, that would be awesome!
This answer is an attempt to get your started.
If you search the internet for "Excel VBA Tutorial" you will get many hits. Try a few because they are all different and pick the one you like best. Work through that tutorial to get a general feel for Excel. I do not believe you will be successful finding bits of relevant code without that general feel.
Do not try to describe your entire problem because I doubt anyone will respond. Instead try to break your problem down into little steps and seek help with those steps.
For example, you will need to determine the number of rows in the post-meeting report so you can access that data. You then want to add that data to the bottom of the previous list. In both cases you need to determine the last used row in a worksheet. "Excel VBA: How to find last row of worksheet?" is a simple question and you will be able to find multiple answers. I give my response to that question below.
I assume the post-meeting report and the list you are creating are in different workbooks. Your macro could be in the same workbook as the list or it could be in a different workbook. Macros can access their own workbooks, any other workbook that happens to be open or they can open as many other workbooks as required. Again "Excel VBA: How do I work with several workbooks?" should result in plenty of hits.
I have not tried either of my questions. I find "Excel VBA:" helps but you may require several attempts before you find the just the right question to get the answer you seek. But if your question is small and precise you should always be able to find an answer.
Let's return to the first question. An irritating feature of Excel VBA is that they are almost always several ways of achieving a similar effect. Create a new workbook, create a module and copy the code below to it. Run the macro FindFinal().
This macro demonstrates several methods of finding the last row and column. Every method has its problems and I have tried to show how how each method can fail. There is a lot of worksheet access within this macro which I believe will repay study. It should help you decide which method is appropriate for each of your requirements.
Option Explicit
Sub FindFinal()
Dim Col As Long
Dim Rng As Range
Dim Row As Long
' Try the various techniques on an empty worksheet
Debug.Print "***** Empty worksheet"
Debug.Print ""
With Worksheets("Sheet1")
.Cells.EntireRow.Delete
Set Rng = .UsedRange
If Rng Is Nothing Then
Debug.Print "Used range is Nothing"
Else
Debug.Print "Top row of used range is: " & Rng.Row
Debug.Print "Left column row of used range is: " & Rng.Column
Debug.Print "Number of rows in used range is: " & Rng.Rows.Count
Debug.Print "Number of columns in used range is: " & Rng.Columns.Count
Debug.Print "!!! Notice that the worksheet is empty but the user range is not."
End If
Debug.Print ""
Set Rng = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious)
If Rng Is Nothing Then
Debug.Print "According to Find the worksheet is empty"
Else
Debug.Print "According to Find the last row containing a value is: " & Rng.Row
End If
Debug.Print ""
Set Rng = .Cells.SpecialCells(xlCellTypeLastCell)
If Rng Is Nothing Then
Debug.Print "According to SpecialCells the worksheet is empty"
Else
Debug.Print "According to SpecialCells the last row is: " & Rng.Row
Debug.Print "According to SpecialCells the last column is: " & Rng.Column
End If
Debug.Print ""
Row = .Cells(1, 1).End(xlDown).Row
Debug.Print "Down from A1 goes to: A" & Row
Row = .Cells(Rows.Count, 1).End(xlUp).Row
Debug.Print "up from A" & Rows.Count & " goes to: A" & Row
Col = .Cells(1, 1).End(xlToRight).Column
Debug.Print "Right from A1 goes to: " & ColNumToCode(Col) & "1"
Col = .Cells(1, Columns.Count).End(xlToLeft).Column
Debug.Print "Left from " & Columns.Count & _
"1 goes to: " & ColNumToCode(Col) & "1"
' Add some values and formatting to worksheet
.Range("A1").Value = "A1"
.Range("A2").Value = "A2"
For Row = 5 To 7
.Cells(Row, "A").Value = "A" & Row
Next
For Row = 12 To 15
.Cells(Row, 1).Value = "A" & Row
Next
.Range("B1").Value = "B1"
.Range("C2").Value = "C2"
.Range("B16").Value = "B6"
.Range("C17").Value = "C17"
.Columns("F").ColumnWidth = 5
.Cells(18, 4).Interior.Color = RGB(128, 128, 255)
.Rows(19).RowHeight = 5
Debug.Print ""
Debug.Print "***** Non-empty worksheet"
Debug.Print ""
Set Rng = .UsedRange
If Rng Is Nothing Then
Debug.Print "Used range is Nothing"
Else
Debug.Print "Top row of used range is: " & Rng.Row
Debug.Print "Left column row of used range is: " & Rng.Column
Debug.Print "Number of rows in used range is: " & Rng.Rows.Count
Debug.Print "Number of columns in used range is: " & Rng.Columns.Count
Debug.Print "!!! Notice that row 19 which is empty but has had its height changed is ""used""."
Debug.Print "!!! Notice that column 5 which is empty but has had its width changed is not ""used""."
Debug.Print "!!! Notice that column 4 which is empty but contains a coloured cell is ""used""."
End If
Debug.Print ""
Set Rng = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious)
If Rng Is Nothing Then
Debug.Print "According to Find the worksheet is empty"
Else
Debug.Print "According to Find the last row containing a formula is: " & Rng.Row
End If
' *** Note: search by columns not search by rows ***
Set Rng = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious)
If Rng Is Nothing Then
Debug.Print "According to Find the worksheet is empty"
Else
Debug.Print "According to Find the last column containing a formula is: " & Rng.Column
End If
' *** Note: Find returns a single cell and the nature of the search
' affects what it find. Compare SpecialCells below.
Debug.Print ""
Set Rng = .Cells.SpecialCells(xlCellTypeLastCell)
If Rng Is Nothing Then
Debug.Print "According to SpecialCells the worksheet is empty"
Else
Debug.Print "According to SpecialCells the last row is: " & Rng.Row
Debug.Print "According to SpecialCells the last column is: " & Rng.Column
End If
Debug.Print ""
Row = 1
Do While True
Debug.Print "Down from A" & Row & " goes to: ";
Row = .Cells(Row, 1).End(xlDown).Row
Debug.Print "A" & Row
If Row = Rows.Count Then Exit Do
Loop
End With
With Worksheets("Sheet2")
.Cells.EntireRow.Delete
.Range("B2").Value = "B2"
.Range("C3").Value = "C3"
.Range("B7").Value = "B7"
.Range("B7:B8").Merge
.Range("F3").Value = "F3"
.Range("F3:G3").Merge
Debug.Print ""
Debug.Print "***** Try with merged cells"
Set Rng = .UsedRange
If Rng Is Nothing Then
Debug.Print "Used range is Nothing"
Else
Debug.Print "Used range is: " & Replace(Rng.Address, "$", "")
End If
Debug.Print ""
Set Rng = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious)
If Rng Is Nothing Then
Debug.Print "According to Find the worksheet is empty"
Else
Debug.Print "According to Find the last cell by row is: " & Replace(Rng.Address, "$", "")
End If
Set Rng = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious)
If Rng Is Nothing Then
Debug.Print "According to Find the worksheet is empty"
Else
Debug.Print "According to Find the last cell by column is: " & Replace(Rng.Address, "$", "")
End If
Debug.Print "!!! Notice that Find can ""see"" B7 but not F3."
Debug.Print ""
Set Rng = .Cells.SpecialCells(xlCellTypeLastCell)
If Rng Is Nothing Then
Debug.Print "According to SpecialCells the worksheet is empty"
Else
Debug.Print "According to SpecialCells the last row is: " & Rng.Row
Debug.Print "According to SpecialCells the last column is: " & Rng.Column
End If
End With
End Sub
Function ColNumToCode(ByVal ColNum As Long) As String
Dim Code As String
Dim PartNum As Long
' Last updated 3 Feb 12. Adapted to handle three character codes.
If ColNum = 0 Then
ColNumToCode = "0"
Else
Code = ""
Do While ColNum > 0
PartNum = (ColNum - 1) Mod 26
Code = Chr(65 + PartNum) & Code
ColNum = (ColNum - PartNum - 1) \ 26
Loop
End If
End Function
In the code above, I access worksheet cells directly with statements such as .Range("B2").Value = "B2". This can be slow particularly when you are moving data from one worksheet to another. An alternative approach is to use arrays.
Dim Rng As Range
Dim ShtValues as Variant
With Worksheets("Xxxx")
Set Rng = .Range(.Cells(Row1, Col1), .Cells(Row2, Col2))
End With
ShtValues = Rng.Value
A Variant is a variable that can hold anything including an array. ShtValues = Rng.Value converts ShtValues to a two-dimensional array hold all the values within Rng. Processing values within an array is much faster that accessing them in the worksheet.
.Range(.Cells(Row1, Col1), .Cells(Row2, Col2)) is perhaps the easiest way of creating a range specifying the worksheet area with Cells(Row1, Col1) as the top left cell and Cells(Row2, Col2) as the bottom right.
If I understand correctly, you want to move data from the post-meeting report to the list but the sequence of columns in the report and list are not the same. This suggests you need to move the data as columns. Using .Range(.Cells(Row1, Col1), .Cells(Row2, Col2)) and with Col1 = Col2, you can define a range that is a column.
Rng1.Copy Destination := Cell2
The above statement will copy the contents of Rng1 to the range starting at Cell2. A statement like this for each column of data in the report may be the easiest way of copying the data.
I hope the above gives you a start.