I want the VBA code to use the value from B1 and present the result in A1, then the VBA code uses the value from B2 and presents the result in A2.
It works for B1 as I get the value in A1. I visible see the cursor on the excel sheet move down the B column, but nothing changes in the A column for results, not even the A1 cell is being overwritten.
It seems that the changing of rows works. However, the code isn't updating to utilize other cells in column A to post results.
This code is pulling an email address from B1, using the LDAP VBA function to make an inquiry of an active directory, and then returning the DisplayName of the member of the email into cell A1.
Range("B1").Select
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)
ActiveSheet.Range("A1").Value = gigIDldap(4, True, Range("B1")) <--A1 will have the value from the gigID1dap VBA function using the value listed in B1
' Insert your code here.
' Step down 1 row from present location.
ActiveCell.Offset(1, 0).Select
Loop
' ******This didn't work. It gave a type mismatch error
For Each Row In ActiveSheet.Rows
ActiveSheet.Range("A1").Value = Row.Value
For Each cell In Values
ValueCell = Range("B1")
Next cell
Next Row
End Sub
Something like this?
Dim r As Long 'row pointer
With ActiveSheet
For r = 1 To .Cells(.Rows.Count, "B").End(xlUp).Row 'loop from row 1 to last used cell in column B
.Cells(r, 1).Value = gigIDldap(4, True, .Cells(r, 2).Value) 'write to column 1 with result from column 2
Next
End With
Related
Need to accomplish below but having issues with code. Included screenshots of data file.
Based on criteria set entered in destination sheet (Football, Baseball, Toyota, Detroit), find column headers in source sheet that match these criteria (accepts 1-6 selections)
Search down all columns where header names match entered criteria
For any row that contains yes in all of the columns where headers match entered criteria, Copy/paste row values from columns C, D, and E of source sheet to destination sheet E14:G (Name, Date, Description).
In this example, only two rows have a yes in all columns that match 4 entered criteria. The associated two rows values were copied to Destination sheet E14
Destination Sheet
destination
Data source sheet*
source
Criteria sheet
criteria sheet
**Edited code per Karma
Sub test()
Dim crit As Range: Dim cell As Range: Dim c As Range
With Sheets("Criteria")
Set crit = .Range("B3,C3,B6,C6,B9,C9")
End With
With Sheets("Source")
For Each cell In crit.SpecialCells(xlCellTypeConstants)
Set c = .Cells.Find(cell.Value)
If Range(Split(c.Address, "$")(1) & Rows.Count).End(xlUp) <>
c.Value Then
.Range("B6").AutoFilter Field:=c.Column - 1,
Criteria1:="=yes", Operator:=xlAnd
Else
MsgBox "no match": Exit Sub
End If
Next
.Range("C7", .Range("C" &
Rows.Count).End(xlUp).Offset(0,2)).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets("Destination").Range("E14")
.ShowAllData
End With
End Sub
If I understand you correctly,
Sub test()
Dim crit As Range: Dim cell As Range: Dim c As Range
With Sheets("Destination")
.Range("E14:G100000").ClearContents
End With
With Sheets("Criteria")
Set crit = .Range("B3,C3,B6,C6,B9,C9")
End With
With Sheets("Source")
For Each cell In crit.SpecialCells(xlCellTypeConstants)
Set c = .Rows(6).Find(cell.Value)
If Range(Split(c.Address, "$")(1) & Rows.Count).End(xlUp) <> c.Value Then
.Range("C6").AutoFilter Field:=c.Column - 2, Criteria1:="=yes", Operator:=xlAnd
Else
MsgBox "no match": Exit Sub
End If
Next
.Range("C7", .Range("C" & Rows.Count).End(xlUp).Offset(0, 2)).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets("Destination").Range("E14")
.ShowAllData
End With
End Sub
The process:
In sheet Destination, first it clear cell E12 to G100000
then in sheet Criteria it create a range of the criteria value into crit variable.
Then it loop to each cell which has value in crit variable
get the cell in sheet Source row 6 which has the same criteria value into variable c
if the column of c variable has no data then it exit the sub
if the column of c variable has data then it filter this column.
After the loop done, it copy the visible cell of the filtered area in column C to E and paste it to sheet Destination cell E14, then show all the data in sheet Source.
To have each name will be put to different row same column, there are two ways to do that. (A) before it write to the Destination sheet, it will ask the user to type what cell the user want to put the looped name. (B) Provide the information in (for example) sheet Criteria, such as cell E2 value = John, cell F2 value = E14 ... cell E3 value = Mike, cell F3 value = E320 ... cell E4 value = Dave, cell F4 value = E1500, and so on until all the unique name in sheet Source is assigned a cell address in column F Sheet Criteria.
Below is using point-B and it's not tested:
So after the loop done, you don't directly copy the result to the Destination sheet, but make a variable of the result first, something like
dim rgResult as range
set rgResult = .Range("C7", .Range("C" & Rows.Count).End(xlUp).Offset(0, 2)).SpecialCells(xlCellTypeVisible).
and also make a variable cnt:
dim cnt as long:cnt=1
Then you loop to the row value of the first column of the rgResult.
for each cell in rgResult.columns(1).cells
The looped cell value will be the name of the person. (say, it's John)
Then you find this name in sheet Criteria column E and get the cell address in column F
cellAddress = sheets("Criteria").range("E:E").find(cell.value).offset(0,1).value
So in this case "John", his cellAddress value is "E14".
Then you write it to the destination sheet:
sheets("Destination").Range(cellAddress).Resize(1, rgResult.Columns.Count).Value = rg.Rows(cnt).Cells.Value
then add the cnt variable for the next row of the rgResult:
cnt = cnt+1
then go to the next loop in the rgResult:
next
FYI, the sub assumed that the macro will be run only once which is just to see what is the result of the criteria filled by the user. The sub also assumed that there will never be a result where the name show more than once. If it's more than once (say, after the first iteration the looped cell in rgResult is John then it write the result to cell E14 sheet Destination) ... then the next iteration if it's John again, it will overwrite the previous result in E14.
So we’re developing a new tracking tool. In the first part of my Macro, if there is a quantity in column M greater than 1, it inserts that many rows (minus 1) underneath. We are trying to isolate each quantity with its own row. So instead of 1 row quantity 9, it shows 9 rows quantity 1.
What I need now is after the first part of the Macro runs, if a cell in Column A is blank, copy row from above and insert into empty cell’s row. I know how to do this on a cell by cell basis in VBA (see below), but there are a lot of blank cells that should be blank.
Fill all empty cells with cell from above will not work because some cells need to be blank. The indicator needs to be in column A and the entire row above needs to be copy and pasted into empty cell row if cell in column A is blank.
Sub Fill()
Dim lr As Long
lr = Cells(Rows.count, 1).End(xlUp).Row
On Error Resume Next
Range("A4:M" & lr).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
End Sub
You can test the cell in column A to see if it is empty, then copy the row above. Might be a more efficient way of doing it, but this works
Sub Fill()
Dim lr As Long
Dim x As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To lr
If IsEmpty(Cells(x, 1)) Then
Cells(x - 1, 1).EntireRow.Copy Cells(x, 1)
End If
Next x
End Sub
Not really any good at vba, but here is some code I have researched which just does not work. All I am trying to do is compare a value in cell B1 to a row of values in cells L3 to AE3. If a match is found I want the number underneath the match on row L4 to AE4 to be copied and pasted as a value in row one directly above the match. It needs to do this automatically via a change event. The value recorded in the first row is to be retained as a value and when the value in B1 changes a new match is copied to row 1 and so on. All recorded values in row one are retained. B1 changes when a formula on another sheet changes value and is linked to B1, so its the result of a formula linked over. Here's my attempt to code it.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
If Intersect(Target, Range("L3:AE3")) Is Nothing Then Exit Sub
Application.EnableEvents = False
For i = 12 To 31 'Columns L3 to AE3
If Cells(1, "B") = Cells(3, i) Then
Cells(1, i) = Cells(4,
Else
End If
Next i
Application.EnableEvents = True
End Sub
Currently I am using the following code to add a formula to cells in the column for a predefined range of cells. The problem is that the number of cells I need the formula in fluctuates based on how big the data set is.
Range("R9").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<0,""False"",""True"")"
Selection.AutoFill Destination:=Range("R9:R12000")
Range("R9:R62053").Select
What I want to do is for every cell that has a value in say column B, I want the macro to insert the formula in the corresponding cell in column C, and stop once it reaches a point where the cell in column b has no value.
The code below is based off the OP's comments. Where as, his code seems to be targeting R9:R12000"
Dim cell As Range, Target As Range
With Worksheets("Sheet1")
Set Target = .Range("B9", .Range("B" & .Rows.Count).End(xlUp))
For Each cell In Target
If cell.Value <> "" Then cell.Offset(0, -1).Formula = "=IF(RC[-1]<0,""False"",""True"")"
Next
End With
Case:
I inserted a new columns name:(Date) and (Time) to column D and E.
But I can't define the last low in column D and E, because of there have no data under D and E.
What i want to do:
column C
1/8/2016 8:24:08
I want to get date 1/8/2016 to column D. and time 8:24:08 to column E.
I found some information about how to find the last row or last column.
http://www.thespreadsheetguru.com/blog/2014/7/7/5-different-ways-to-find-the-last-row-or-last-column-using-vba
But i still not understand how to let vba know the last row. Can please someone can help me know, how am i need to define it. Thank you.
LastColumn = ??
Range("D2:D" & LastColumn).Formula = "=LEFT(C2,(FIND("" "",C2,1)-1))"
My excel page
as to your specific issue
since you already have a "complete" date in column "C" cells, you just need to use TEXT() function to parse it down to the wanted part, as follows:
....FormulaR1C1 = "=TEXT(RC3,""gg/m/aaaa"")"
....FormulaR1C1 = "=TEXT(RC3,""hh:mm:ss"")"
where you'd also use .FormulaR1C1 property to adopt R1C1 style address notation which is more useful for the current purpose letting you write RC3 and refer to column "3" (i.e. column "C") cell in the same row of where you're writing the formula in
as for the lastRow issue
to get the last non empty cell in a given column you'd write something like:
lastRow = Cells(Rows.Count, "C").End(xlUp)).Row '<--| get column "C" last non empty cell row
but please note that should the given column be empty then it'd return 1 as if cell in row 1 were not empty. so you may want to add a check like the following:
lastRow = Cells(Rows.Count, "C").End(xlUp)).Row '<--| get column "C" last non empty cell row
If .Cells(GetLastRow, "C") = "" Then lastRow = 0 '<--| return 0 if empty column
and handle the case of a return "zero" value
furthermore note that the above code implicitly assumes currently active workbook and worksheet reference, which can often be not safe should you (or your code) make any worksheet/workbook "jumping".
so you'd better add explicit worksheet (and workbook) references like follows:
lastRow = Workbooks("MyWorkbookname").Worksheets("MyWorksheetName").Cells(Workbooks("MyWorkbookname").Worksheets("MyWorksheetName").Rows.Count, "C").End(xlUp)).Row '<--| get column "C" last non empty cell row
If Workbooks("MyWorkbookname").Worksheets("MyWorksheetName").Cells(GetLastRow, "C") = "" Then lastRow = 0 '<--| return 0 if empty column
where you HAVE to qualify those workbook/worksheet references in EVERY range reference
now, you can take advantage of the With keyword to both lessen the burden of typing all that jazz and make code more readable and maintainable, as follows:
With Workbooks("MyWorkbookname").Worksheets("MyWorksheetName")
lastRow = .Cells(.Rows.Count, colIndex).End(xlUp).row
If .Cells(lastRow, colIndex) = "" Then lastRow = 0
End With
so that you can finally type your following GetLastRow() function:
Function GetLastRow(sht As Worksheet, colIndex As Long) As Long
With sht '<--| refer to the passed worksheet
GetLastRow = .Cells(.Rows.Count, colIndex).End(xlUp).row '<--| get its passed column last non empty cell
If .Cells(GetLastRow, colIndex) = "" Then GetLastRow = 0 '<--| check for empty column
End With
End Function
getting it all together you may may come up to the following code
Sub main()
With Workbooks("MyWorkbookName").Worksheets("MyData") '<--| refer to your worksheet (change "MyData" to your actual sheet name)
With .Range("C1", .Cells(.Rows.Count, "C").End(xlUp)) '<--| refer to its column "C" range from row 1 down to last non empty cell
.Offset(, 1).FormulaR1C1 = "=TEXT(RC3,""gg/m/aaaa"")" '<-- write date in column "C"
.Offset(, 2).FormulaR1C1 = "=TEXT(RC3,""hh:mm:ss"")" ' <-- write hour in column "C"
With .Offset(, 1).Resize(, 2)
.value = .value
End With
End With
End With
End Sub
you may then want to change it and use the GetLastRow() function