My code does what I want, but it copies it to column A in sheet 2. I would like it to put the data in starting at Column B if possible.
Sub EFP()
Dim keyword As String: keyword = Sheets("Results").Range("B3").Value
Dim countRows1 As Long, countRows2 As Long
countRows1 = 3 'the first row of my dataset in the Data tab
endRows1 = 500 'the last row of my dataset in the Data tab
countRows2 = 6 'the first row where I want to start writing the found rows
For j = countRows1 To endRows1
If Sheets("Data").Range("B" & j).Value = keyword Then
Sheets("Results").Rows(countRows2).Value = Sheets("Data").Rows(j).Value
countRows2 = countRows2 + 1
End If
Next j
End Sub
If you copy and paste whole rows, they will always start in column A. If you want the result to start in column B, you need a different approach, for example
Sheets("Results").Range("B" & countRows2 & ":Z" & countRows2).Value = Sheets("Data").Range("A" & j & ":Y" & j).Value
Related
I have written a code which gives me exact count of empty/blank cells in a column/s.
This shows the results if I run the code for column A
Sub countblank()
Const column_to_test = 2 'column (B)
Dim r As Range
Set r = Range(Cells(2, column_to_test), Cells(Rows.Count,
column_to_test).End(xlUp))
MsgBox ("There are " & r.SpecialCells(xlCellTypeBlanks).Count & " Rows
with blank cells in column B")
Const columns_to_test = 3 'column (C)
Set r = Range(Cells(3, columns_to_test), Cells(Rows.Count,
columns_to_test).End(xlUp))
MsgBox ("There are " & r.SpecialCells(xlCellTypeBlanks).Count & " Rows
with blank cells in column c ")
'and so on i can count the blanks for as many columns i want
End Sub
But the problems are as follows:-
If there are no blanks, this macro will throw an error and will terminate itself. What if I want to run the remaining code?
Using array or something equivalent I want to search the multiple columns by header at the same time, instead of column number that to separately as shown in the code.
If a blank/s is found it pops a Msgbox but can we get the list of error in a separate new sheet called "error_sheet"?
Function getBlanksInListCount(ws As Worksheet, Optional FirstRow = 2, Optional TestColumn = 2)
With ws
getBlanksInListCount = WorksheetFunction.countblank(.Range(.Cells(FirstRow, TestColumn), .Cells(.Rows.Count, TestColumn).End(xlUp)))
End With
End Function
Try this
Sub countblank()
Dim i As Long
For i = 2 To 10 ' for looping through the columns
Dim r As Range
Set r = Range(Cells(2, i), Cells(Rows.Count, i).End(xlUp))
'for not getting error and adding error messages in the error_sheet
'MsgBox ("There are " & Application.WorksheetFunction.countblank(r) & " Rows with blank cells in column" & r.Column)
Sheets("error_sheet").Range(r.Address).Value = "There are " & Application.WorksheetFunction.countblank(r) & " Rows with blank cells in column" & r.Column
Next i
End Sub
Try sub MAIN to examine the first three columns:
Sub countblank(column_to_test As Long)
Dim r As Range, rr As Range, col As String
col = Split(Cells(1, column_to_test).Address, "$")(1)
Set r = Range(Cells(2, column_to_test), Cells(Rows.Count, column_to_test).End(xlUp))
On Error Resume Next
Set rr = r.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If rr Is Nothing Then
MsgBox ("There are no Rows with blank cells in column " & col)
Else
MsgBox ("There are " & r.SpecialCells(xlCellTypeBlanks).Count & " Rows with blank cells in column " & col)
End If
End Sub
Sub MAIN()
Dim i As Long
For i = 1 To 3
Call countblank(i)
Next i
End Sub
Q1 can be answered by using an error handling statement. Error handling statements can be as simple or complicated as one would like them to be. The one below is probably my first go to method.
' if no blank cells found, code continues
On Error Resume Next
MsgBox ("There are " & r.SpecialCells(xlCellTypeBlanks).Count & _
" Rows with blank cells in column B")
Using headers would work fine. Please see final answer below for this method.
This answer is a minor change from the answer submitted by Imran Malek
Sub countblank()
Dim i As Long
' new integer "row" declared
Dim row As Integer
' new integer "row" set
row = 1
For i = 2 To 4 ' for looping through the columns
Dim r As Range
Set r = Range(Cells(2, i), Cells(Rows.Count, i).End(xlUp))
'for not getting error and adding error messages in the error_sheet
'MsgBox ("There are " & Application.WorksheetFunction.countblank(r) & " Rows with blank cells in column" & r.Column)
' using the value in row to insert our output
Sheets("error_sheet").Range("A" & row).Value = "There are " & Application.WorksheetFunction.countblank(r) & " Rows with blank cells in column" & r.Column
' adding 1 to "row" to prep for next output
row = row + 1
Next i
End Sub
Final answer: My apologies for the lengthy answer. This answer is a modification of Imran Malek's answer, found in the link of answer 3. Please note, this version does not contain error handling, explained in Q1.
Sub countblank()
Dim Header(1 To 4) As String
Header(1) = "Name"
Header(2) = "Age"
Header(3) = "Salary"
Header(4) = "Test"
Dim i As Integer
Dim row As Integer
Dim r As Range
Dim c As Integer
row = 1
' **NOTE** if you add any more values to {Header}, the loop has to be equal to the Header count
' i.e. 4 {Headers}, 4 in the loop
For i = 1 To 4
'looking for the header in row 1
c = Cells(1, 1).EntireRow.Find(What:=Header(i), LookIn:=xlValues).Column
'defining the column after header is found
Set r = Range(Cells(2, c), Cells(Rows.Count, c).End(xlUp))
' using the value in row to insert our output
Sheets("error_sheet").Range("A" & row).Value = "There are " & Application.WorksheetFunction.countblank(r) & " Rows with blank cells in column" & r.Column
' adding 1 to "row" to prep for next output
row = row + 1
Next i
End Sub
I got these 2 tables, 1 is a datatable, the 2nd is a instruction table.
everyday i will update the instruction table, and run the macro, which will update the datatable accordingly based on ID.
It is currently really simple. If datatable ID (Col A) matches instructiontable ID (Col J) then the corresponding data Col B-F will update according to instructiontable.
Datatable
Col A= ID
Col B-G = Different names
The instruction table is:
Col I is add (change to Y) or delete (change to N) Col K i
Col J is ID
COl K indicates which name (Header of Col B-G) to update.
Sub updatedatatable()
On Error Resume Next
Dim instructionlastrow, findtablecolumn, findtablerow As Long
Dim findid As Integer
instructionlastrow = Range("I" & Rows.Count).End(xlUp).Row
For i = 2 To instructionlastrow
findid = 0
If Range("I" & i).Value = "Add" And Range("A:A").Find(Range("J" & i).Value).Row = 0 Then
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Value = Range("J" & i).Value
findtablecolumn = Rows(1).Find(Range("K" & i)).Column
findtablerow = Range("A:A").Find(Range("J" & i)).Row
Cells(findtablerow, findtablecolumn).Value = "Y"
ElseIf Range("I" & i).Value = "Add" And Range("A:A").Find(Range("J" & i).Value).Row <> 0 Then
findtablerow = Range("A:A").Find(Range("J" & i)).Row
findtablecolumn = Rows(1).Find(Range("K" & i)).Column
Cells(findtablerow, findtablecolumn).Value = "Y"
ElseIf Range("I" & i).Value = "Remove" And Range("A:A").Find(Range("J" & i).Value).Row <> 0 Then
findtablerow = Range("A:A").Find(Range("J" & i)).Row
findtablecolumn = Rows(1).Find(Range("K" & i)).Column
Cells(findtablerow, findtablecolumn).Value = "N"
End If
Next i
End Sub
i was wandering if anyone can teach me so that the Instruction table can be loaded from a different workbook.
Thanks
I'm not sure excactly what the relation of the two tables are supposed to be according to your description, but I understand as this; you currently have them in the same workbook (in the same worksheet?) but want to have them in different workbooks.
To access a workbook from another workbook in vba you can use the Workbooks.Open method
https://msdn.microsoft.com/en-us/library/office/ff194819.aspx
I can also recommend some code examples from Ron de Bruin
http://www.rondebruin.nl/win/section3.htm
Since you haven't made any coding attempts to access separate workbooks I'm not 100% what you want to do, but please have a look at the links, make an attempt at a solution and get back if you get stuck again.
I need a VBA script that will look at the account number in column A of the source worksheet and find it's exact match in column A the target worksheet. When the match is found, it needs to copy cells "J" through "M" from the source worksheet into cells "O" through "S" of the target worksheet.
There are about 80 rows in the source worksheet and over 500 rows in the target worksheet. The account numbers in both worksheets will have exact matches, but the numbers aren't sequential from one row to the next.
Any help is greatly appreciated.
Something like this might work for you:
For i = 1 to 90
For j = 1 to 600
If SourceWorksheet.Range("A" & i).Value _
= TargetWorksheet.Range("A" & j).Value Then
TargetWorksheet.Range("O" & j, "S" & j) _
= SourceWorksheet.Range("J" & i, "M" & i)
End If
Next j
Next i
Sheet target
Sheet source
String accountNum
set target = Workbook.sheet("sheetName")
set source = ActiveSheet
accountNum = Selection.cell(1,1)
Boolean found
Integer i
i = 1
found = false
while(target.cell(i,1) <> "" AND NOT found)
if (target.cell(i,1) = accountNum) then found = true
wend
if not found then return
for Integer j = 0 to 3
target.cell(i, j + 15) = source.cell(Selection.Row, j + 10)
next
Please note, I haven't done much VBA in years so syntax may be off.
I need a little bit help with a macro of Excel.
I need to create a macro that automatically find users and copy the values that i have in an other Sheet:
I have one sheet with values that contains the Users and their Kills and Deaths, I create 3 sheets more (3 different groups of users), and I need that the macro copy values automatically finding the users and copying values.
Images to describe it better:
----(Copy this values on)----->
You don't need a macro for this, using the worksheetfunction VLOOKUP is sufficient.
As an example, if you have your headers in row 1 and users in column A, what you'd put into cell B2 (the number of kills for the first user) would be =VLOOKUP($A2;Values!$A$2:$C$9;2;FALSE) and C2 would be =VLOOKUP($A2;Values!$A$2:$C$9;3;FALSE).
The arguments for the function (which you can also find in the linked document) is:
First, the value you're looking for, in your case whatever is in A2
Next the array of values which you want to return a result from - vlookup will only look through the first column, but since you want to return results from the other columns we include columns A:C in the formula.
What column in the range you search to return the result from for kills it is column 2, for deaths column 3.
Finally whether you want to have an exact match (false) or if an approximate one is ok (true).
If I understand what you're after, you should be able to do this with VLOOKUPs
(No VBA necessary)
The following source code solve your problem.
Option Explicit
Dim MyResultWorkbook As Workbook
Dim ValuesWorksheet As Worksheet
Dim SniperWorksheet As Worksheet
Dim ARsWorksheet As Worksheet
Sub CopyResult()
Set MyResultWorkbook = ActiveWorkbook
Set ValuesWorksheet = MyResultWorkbook.Sheets("Values")
Set SniperWorksheet = MyResultWorkbook.Sheets("Sniper")
Set ARsWorksheet = MyResultWorkbook.Sheets("Ars")
Dim SniperLastRow As Long
Dim ARLastRow As Long
Dim RowPointer As Long
Dim ValuePointer As Long
ValuePointer = 2
'Update the Sniper worksheets
SniperLastRow = SniperWorksheet.Cells(SniperWorksheet.Rows.Count, "A").End(xlUp).Row
For RowPointer = 2 To SniperLastRow
Do While (SniperWorksheet.Range("A" & RowPointer).Value <> ValuesWorksheet.Range("A" & ValuePointer).Value)
ValuePointer = ValuePointer + 1
Loop
SniperWorksheet.Range("A" & RowPointer).Offset(0, 1).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 1).Value 'copy kill
SniperWorksheet.Range("A" & RowPointer).Offset(0, 2).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 2).Value 'copy death
ValuePointer = 2
Next
'Update the Ars worksheets
ARLastRow = ARsWorksheet.Cells(ARsWorksheet.Rows.Count, "A").End(xlUp).Row
For RowPointer = 2 To ARLastRow
Do While (ARsWorksheet.Range("A" & RowPointer).Value <> ValuesWorksheet.Range("A" & ValuePointer).Value)
ValuePointer = ValuePointer + 1
Loop
ARsWorksheet.Range("A" & RowPointer).Offset(0, 1).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 1).Value 'copy kill
ARsWorksheet.Range("A" & RowPointer).Offset(0, 2).Value = ValuesWorksheet.Range("A" & ValuePointer).Offset(0, 2).Value 'copy death
ValuePointer = 2
Next
End Sub
Is there a way for me to get the logic in an Excel Macro (or add-in) to pull and manipulate data from multiple spreadsheets?
Something along the lines of: For each row in Spreadsheet A(If site URL in Spreadsheet A = Site URL in Spreadsheet B, then copy value "Spreadsheet B Column X" into Spreadsheet A Column Y).
There sure is. This is done using the sheets() command to switch between sheets. You can either use indexes (they start at 1) or if you have named sheets you can type in the name as a string sheets("reports").activate
This code will do the comparison for you. We assume sheet A is Sheets(1) and sheet B is assumed to be sheets(2), We are only comparing column A from both sheets
Sub test()
col_2_search = "A"
LastRowA = Sheets(1).Cells(Sheets(1).Rows.Count, col_2_search ).End(xlUp).Row
For curr_row = 1 To LastRowA
val_from_a = Sheets(1).Cells(curr_row, col_2_search ).Value
val_from_b = Sheets(2).Cells(curr_row, col_2_search ).Value
If (val_from_a = val_from_b) Then
'this should be where you put your copy paste code
MsgBox ("match row " & curr_row & " value:" & val_from_a)
End If
Next
End Sub
Edit
An alternative solution for using match. There may be a cleaner way to write this, but I just threw it up really quickly
Sub test()
col_2_search = "A"
LastRowA = Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Row
LastRowB = Sheets(2).Cells(Sheets(2).Rows.Count, "A").End(xlUp).Row
For curr_row = 1 To LastRowA
value_from_A = Sheets(1).Cells(curr_row, col_2_search ).Value
'we are searching B from column 1 to the last populated column in b
Var = Application.Match(value_from_A, Range(Sheets(2).Cells(1, col_2_search ), Sheets(2).Cells(LastRowB, col_2_search )))
'if there wasn't an error, var contains the row of range B that matches
'a
If Not (IsError(Var)) Then
MsgBox ("Row " & curr_row & " of A matches row " & Var & " of B, both contain: " & value_from_A)
End If
Next
End Sub