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
Related
I have two sheets in an excel file namely bank_form and Pay_slip.
I am trying to write a vba to check whether value/text in cell B5 of sheet Pay_slip is equal to value/text in cell B8 of sheet Bank_form. Similary it will check all values till the last row of sheet Pay_slip.
But my code is not working it always comes true i.e. it always flash the message "All employees found."
Please find my mistake(s).
Sub CommandButton1_Click()
Dim LastRow As Long
LastRow = Worksheets("Bank_form").Range("B" & Rows.Count).End(xlUp).Row
LR = Worksheets("Pay_slip").Range("B" & Rows.Count).End(xlUp).Row
If Worksheets("Pay_slip").Range("B5" & LR).Value = Worksheets("Bank_form").Range("B8" & LastRow) Then
MsgBox "All Employees Found."
Worksheets("Bank_form").Range("F" & LastRow + 1).Formula = "=SUM(F8:F" & LastRow & ")"
Else: MsgBox "Employee(s) missing Please check again!"
End If
End Sub
you will need a loop something like this
Dim i as Long
For i = 5 to LastRow 'start at B5
If Worksheets("Pay_slip").Range("B" & i).Value = Worksheets("Bank_form").Range("B" & i + 3) Then
' ... your other stuff here
next i
If Worksheets("Pay_slip").Range("B5").Value = Worksheets("Bank_form").Range("B8").Value Then MsgBox "The values are the same"
I have no idea why you involved the number of rows in your code but they are useless in order to check the equivalence in the values in a specific cell only
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
I am currently facing an issue in which my 'for each' loop is not moving onto subsequent cells for each cell in the range I have defined when I try to execute the script. The context around the data is below:
I have 3 columns of data. Column L contains employees, Column K contains managers, and column J contains VPs. Column K & J containing managers and VPs are not fully populated - therefore, I would like to use a VBA script & Index Match to populate all the cells and match employees to managers to VPs.
I have created a reference table in which I have populated all the employees to managers to directors and have named this table "Table 4". I am then using the VBA code below to try and run through each cell in column K to populate managers:
Sub FillVPs()
Dim FillRng As Range, FillRng1 As Range, cell As Range
Set FillRng = Range("J2:J2000")
Set FillRng1 = Range("K2:K2000")
For Each cell In FillRng1
If cell.Value = "" Then
ActiveCell.Formula = _
"=INDEX(Table4[[#All],[MGRS]], MATCH(L583,Table4[[#All],[EMPS]],0))"
End If
Next cell
End Sub
I feel that something is definitely wrong with the index match formula as the match cell "L583" is not moving to the next cell each time it runs through the loop; however, I am not sure how to fix it. I also do not know what else is potentially missing. The code currently executes, but it stays stuck on one cell.
Any help is greatly appreciated, and I will make sure to clarify if necessary. Thank you in advance.
The problem is that you are only setting the formula for the ActiveCell.
ActiveCell.Formula = _
"=INDEX(Table4[[#All],[MGRS]], MATCH(L583,Table4[[#All],[EMPS]],0))"
This should fix it
cell.Formula = _
"=INDEX(Table4[[#All],[MGRS]], MATCH(L583,Table4[[#All],[EMPS]],0))"
You'll probably need to adjust L583. It will not fill correctly unless you are filling across all cell.
These ranges should probably be changed so that they are dynamic.
Set FillRng = Range("J2:J2000")
Set FillRng1 = Range("K2:K2000")
You should apply the formula to all the cells in the range
Range("K2:K2000").Formula = "=INDEX(Table4[[#All],[MGRS]], MATCH(L2,Table4[[#All],[EMPS]],0))"
UPDATE: Dynamic Range
Every table in Excel should have at least one column that contain an entry for every record in the table. This column should be used to define the height of the Dynamic Range.
For instance if Column A always has entries and you want to create a Dynamic Range for Column K
lastrow = Range("A" & Rows.Count).End(xlUp).Row
Set rng1 = Range("K2:K" & lastrow)
Or
Set rng1 = Range("A2:A" & Rows.Count).End(xlUp).Offset(0, 10)
UPDATE:
Use Range.SpecialCells(xlCellTypeBlanks) to target the blank cells. You'll have to add an Error handler because SpecialCells will throw an Error if no blank cells were found.
On Error Resume Next
Set rng1 = Range("A2:A" & Rows.Count).End(xlUp).Offset(0, 10).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If rng1 Is Nothing Then
MsgBox "There were no Blank Cels Found", vbInformation, "Action Cancelled"
Exit Sub
End If
The "L583" was not changing because you were not telling it to. The code below should change the reference as the cell address changes.
Range.Address Property
Sub FillVPs()
Dim FillRng As Range, FillRng1 As Range, cell As Range
Set FillRng = Range("J2:J2000")
Set FillRng1 = Range("K2:K2000")
For Each cell In FillRng1
If cell.Value = "" Then
cell.Formula = _
"=INDEX(Table4[[#All],[MGRS]], MATCH(" & cell.Offset(0,1).Address() & ",Table4[[#All],[EMPS]],0))"
End If
Next cell
End Sub
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?
The purpose of this macro is copy one cell value (from a long list) to another cell located in a different sheet.
here's my code:
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = Range("G2:G1048576")
For Each cell In Rng
'test if cell is empty
If cell.Value <> "" Then
finaljnl.Range("L4").Value = rawben.Range("G5").Value
finaljnl.Range("K4").Value = rawben.Range("L5").Value
End If
Next
End Sub
With the help of the image, I will explain what I'm trying to achieve:
From Sheet1 ("BEN") there's a list sitting in columns G and L.
I will copy the cell G5 from Sheet1 and paste it in Sheet2 ("JNL_BEN") Range K4.
Next is I will copy the cell L5 from Sheet1 and paste it in Sheet2 ("JNL_BEN") Range L4.
Copy the next in line and do the same process just like No.2 and 3 but this time, it will adjust 1 row below.
Copy the whole list. That means up to the bottom. The list is dynamic, sometimes it will go for 5,000 rows.
For some reasons, copying the entire column is not an option to this macro due to requirement that cells from sheet1 MUST be pasted or placed in Sheet2 from left to right (or horizontally).
I hope you could spare some time to help me. My code didn't work, I guess the implementation of FOR EACH is not correct. I'm not sure if FOR EACH is the best code to use.
I appreciate anyone's help on this. Thank you very much! May the force be with you.
Try this:
Sub journalben()
Dim i As Long, lastRow As Long
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
lastRow = rawben.Cells(Rows.Count, "G").End(xlUp).Row
For i = 5 To lastRow
'test if cell is empty
If rawben.Range("G" & i).Value <> "" Then
finaljnl.Range("K" & i - 1).Value = rawben.Range("G" & i).Value
finaljnl.Range("L" & i - 1).Value = rawben.Range("L" & i).Value
End If
Next i
End Sub
I am starting FOR from 5 as the data in your image starts from cell G5 (not considering the header).
It'll be easier to use a numeric variable for this :
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = rawben.Range("G4:G1048576")
For i = Rng.Cells(1,1).Row to Rng.Cells(1,1).End(xlDown).Row
'test if cell is empty
If rawben.Range("G" & i).Value <> vbNullString Then
finaljnl.Range("L" & i - 1).Value = rawben.Range("G" & i).Value
finaljnl.Range("K" & i - 1).Value = rawben.Range("L" & i).Value
End If
Next i
End Sub
You should use a simple for loop. It is easier to work with.
Also, to have it dynamic and to go to the last cell in the range, use the SpecialCells method.
And your range needs to be set correctly from row 5.
Here is the code:
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = Range("G5:G1048576")
For i = Rng.Cells(1,1).Row to Rng.SpecialCells(xlCellTypeLastCell).Row
If rawben.Range("G" & i).Value <> vbNullString Then
finaljnl.Range("L" & CStr(i - 1)).Value = rawben.Range("G" & CStr(i)).Value
finaljnl.Range("K" & CStr(i - 1)).Value = rawben.Range("L" & CStr(i)).Value
End If
Next i
End Sub