I have two sheets in my workbook. The first is supposed to display data from the second sheet that has a lot of data.
I have put a macro button on the display sheet where if I enter a specific value in the referenced cell and then click the button it displays all the rows in my data sheet that has it's value.
The problem is I can only search for a single value to display but I want to use another two cells to put other values like using conditions, to be specific is date duration.
cell 1... Name,
cell 2... Start Date,
cell 3... End Date
Upon clicking the button it should display all the rows in the data sheet that has the values of specific name, a date in the second cell and a date in the third cell.
Here's the code I'm currently using,
Sub SearchMultipleValues()
Dim eRow As Long
Dim ws As Worksheet
Dim lastrow As Long
Dim count As Integer
lastrow = Sheets("DATA").Cells(Rows.count, 1).End(xlUp).Row
Sheet2.Range("A5:L1048569").ClearContents
count = 0
Dim p As Long
p = 2
For X = 2 To lastrow
If Sheets("DATA").Cells(X, 1) = Sheet2.Range("A1") Then
Sheet1.Cells(p, 1) = Sheets("Sheet2").Cells(X, 1)
Sheet1.Cells(p, 2) = Sheets("Sheet2").Cells(X, 2)
Sheet1.Cells(p, 3) = Sheets("Sheet2").Cells(X, 3)
Sheet1.Cells(p, 4) = Sheets("Sheet2").Cells(X, 4)
Sheet1Cells(p, 5) = Sheets("Sheet2").Cells(X, 5)
Sheet1.Cells(p, 6) = Sheets("Sheet2").Cells(X, 6)
Sheet1.Cells(p, 7) = Sheets("Sheet2").Cells(X, 7)
Sheet1.Cells(p, 8) = Sheets("Sheet2").Cells(X, 8)
Sheet1.Cells(p, 9) = Sheets("Sheet2").Cells(X, 9)
Sheet1.Cells(p, 10) = Sheets("Sheet2").Cells(X, 10)
Sheet1.Cells(p, 11) = Sheets("Sheet2").Cells(X, 11)
Sheet1.Cells(p, 12) = Sheets("Sheet2").Cells(X, 12)
p = p + 1
count = count + 1
End If
Next X
MsgBox " The number of item found is " & " " & count
End Sub
The cell A1 is where I type the value I want to display in the "Sheet1" that is from the data sheet "Sheet2". Now I want to include cell A2 and A3 as additional values that sticks with the value in cell A1 in the data sheet.
You can abandon the loop altogether. Try using Filter method of the Range Object.
Dim sh As Worksheet, lastrow As Long, datarange As Range
Set sh = Sheets("DATA") '// set the source sheet //
'// clear destination sheet focusing on columns that will be used //
Sheet2.Range("A5:L" & Sheet2.Rows.Count).ClearContents
With sh
lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
Set datarange = .Range("A1:L" & lastrow) '// set the source row //
End With
'// filter based on sheet2 A1 value //
datarange.AutoFilter 1, Sheet2.Range("A1").Value2, xlFilterValues
'// copy filtered values
datarange.SpecialCells(xlCellTypeVisible).Copy
'// paste to destination
Sheet2.Range("A2").PasteSpecial xlPasteValuesAndNumberFormats
You can have a go at this and if it works, adjust to suit your needs. This is not tested as I have no way of doing it now. Hope this helps though.
Related
I have one problem that I need to solve and is as following. I would like to insert data into cells if conditions are met. Conditions are from cells M1 to M3 and this cells are in dropdown list.
Cell M1 is column B:B
Cell M2 is column C:C
Cell M3 is column D:D
Cell M4 is typed manualy
Cell M5 is a number and is also typed manualy(randoml)
Once I defined from dropdown cells M1 to M3 and type some text in cell M4 and type a number in cell M5, program should insert in column H cell M4, in column I program should automaticaly insert today date and in column J sould automaticaly insert actual time. In how many cells should be this inserted is defined in cell M5. If in some part of the table, row are reserved, macro should skip this already inserted data
If from the table there is no free/empty cells, then the program should inform a user with a notification
Could you please help me to create a macro to automaticaly insert data into cells
Thank you
I try this in attached table, but unfirtunately, results are not this what I expected
Sub code_res()
Dim lr As Long, r As Long
Dim i As Integer
Dim iSheet As Worksheet
Dim ans As Integer
Set iSheet = Worksheets("List1")
lr = Cells(Rows.Count, "A").End(xlUp).Row
i = 0
Cells(4, 14) = 0
For r = 7 To lr
If Cells(r, 2) = Cells(1, 13) And Cells(r, 3) = Cells(2, 13) And Cells(r, 7) = "" Then
Cells(r, 7) = Cells(3, 13)
Cells(r, 9) = Date
With Cells(r, 10)
.Value = Time
.NumberFormat = "hh:mm:ss"
i = i + 1
If i = Cells(4, 13) Then
Exit For
End If
End With
End If
Next r
iSheet.Range("M4") =
iSheet.Application.WorksheetFunction.CountIf(iSheet.Range("H:H"),
iSheet.Range("M3"))
'testing quantity and export
If Cells(4, 13) > Cells(4, 14) Then
ans = MsgBox("Quantity of reservation " & Cells(4, 14), vbQuestion + vbYesNo,"Do you want to do a export?")
If ans = vbYes Then
Call Izvoz1 'data export
Else
MsgBox "Data are not exported"
End If
Else
Call Izvoz1 'data export
MsgBox "Succesesfully exported"
End If
End Sub
I want to collect data from a large worksheet and paste to a target range.
The data mix with number and number like string (ex:"0050").
I tried a variant array to store the data and assign to a series of cells.
Here is the sample code:
Dim z() As Variant
Dim i As Integer
ReDim z(1 To 3, 1 To 1)
With ThisWorkbook.Sheets(1)
.Cells(1, 1) = "'" & "0050" 'content from cell A, could be number or number like string.
.Cells(3, 1) = 20 'content from cell B, could be number or number like string.
.Cells(5, 1) = "'" & "040" 'content from cell C, could be number or number like string.
For i = 1 To 3
z(i, 1) = .Cells(1 + (i - 1) * 2, 1)
Next
.Cells(1, 2).Resize(3, 1) = z
End With
Excel automatically changes the string "0050" to a number format so the value in cell(1,2) is 50, not "0050".
I want the cell's format to be the same as it originally was but I don't know each cell's format in advance.
I can use a loop to assign each cell to another but the running speed will be slow:
Dim z() As Variant
Dim i As Integer
ReDim z(1 To 3, 1 To 1)
With ThisWorkbook.Sheets(1)
.Cells(1, 1) = "'" & "0050" 'content from cell A, could be number or number like string.
.Cells(3, 1) = 20 'content from cell B, could be number or number like string.
.Cells(5, 1) = "'" & "040" 'content from cell C, could be number or number like string.
For i = 1 To 3
.Cells(i, 2) = .Cells(1 + (i - 1) * 2, 1)
Next
End With
Is there a way to avoid Excel automatically changing the string to number?
Another solution:
Sub test()
Dim Lastrow As Long
Dim str As String
With ThisWorkbook.Worksheets("Sheet1")
str = "00005"
With .Range("A1")
'Change cell format to TEXT before you enter value
.NumberFormat = "#"
.Value = str
End With
End With
End Sub
I am started a Invoice with Vba. I have Code to copy a range of non empty cells and paste to another sheet and it is working perfectly but I want to copy some other cells and Paste them all in a row after the last used row.
Like
"Invoice No, Date, Customer Name, Salesman Name and Total" as I can Used these to track Invoice.
Sub CopyRange()
Dim x, y(), i As Long, ii As Long
x = Sheets("Invoice").[a12:g49]
For i = 1 To UBound(x, 1)
If x(i, 1) <> "" Then
ReDim Preserve y(1 To 7, 1 To i)
For ii = 1 To 7
y(ii, i) = x(i, ii)
Next
Else: Exit For
End If
Next
With Sheets("Invoice Record")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(y, 2), 7) = Application.Transpose(y)
End With
End Sub
I have 3 workbooks in one folder. I use macro to copy each Sheet1 in every workbook in that folder into my workbook example.
In my workbook example now I have 4 sheets named sheet1, sheet1 (4), sheet1 (3), sheet1 (2).
I want to use a button form so when I click it, the code (below) run for any other sheets except sheet one.
Sub Copy_Sum()
Dim ws As Worksheet
'Selecting the worksheets to loop through
K = 1
For Each ws In ThisWorkbook.Worksheets
'Skiping the sheet1
If ws.Name <> "Sheet1" Then
'Counting the number of rows for automation
rowscount = Cells(Rows.Count, 1).End(xlUp).Row
temp = 0
'add name
Cells(rowscount + 1, 8) = "Jumlah"
Cells(rowscount + 2, 8) = "Mutasi"
'Looping throught the cells for the calculation
For j = 2 To (rowscount)
'Counting the number of cells which value greater than zero
If Cells(j, 9) > 0 Then
temp = temp + 1
End If
Next j
'Counting the number of rows for automation
rowscount1 = Cells(Rows.Count, 1).End(xlUp).Row
temp1 = 0
For i = 2 To (rowscount1)
'Counting the number of cells which value greater than zero
If Cells(i, 10) > 0 Then
temp1 = temp1 + 1
End If
Next i
'Summing up the values which are above the current cell
'and in Sheet1, this inclues negative numbers as well
Cells(rowscount + 1, 9).Value = Application.Sum(Range(Cells(1, 9), _
Cells(rowscount, 9)))
Cells(rowscount + 2, 9) = temp
Cells(rowscount1 + 1, 10).Value = Application.Sum(Range(Cells(1, 10), _
Cells(rowscount1, 10)))
Cells(rowscount1 + 2, 10) = temp1
End If
Next ws
End Sub
I'm don't fully understand the macro code. This code was made by editing the code from NEOmen and I really appreciate it.
This is code supposed to automatically loop the code for each sheet except sheet1 but it didn't work.
I must run the code manually in sheet1 (4), sheet1 (3), sheet1 (2) to get it done.
I think I can edit it a little bit like what I wanted, but I can't. I got stuck in the end.
the code after revision from #chris neilsen #L42
Sub Copy_Sum()
Dim ws As Worksheet
'Selecting the worksheets to loop through
K = 1
For Each ws In ThisWorkbook.Worksheets
'Skiping the sheet1
With ws
If .Name <> "Sheet1" Then
'Counting the number of rows for automation
rowscount = .Cells(.Rows.Count, 1).End(xlUp).Row
temp = 0
'add name
.Cells(rowscount + 1, 8) = "Jumlah"
.Cells(rowscount + 2, 8) = "Mutasi"
'Looping throught the cells for the calculation
For j = 2 To (rowscount)
'Counting the number of cells which value greater than zero
If .Cells(j, 9) > 0 Then
temp = temp + 1
End If
Next j
'Counting the number of rows for automation
rowscount1 = .Cells(.Rows.Count, 1).End(xlUp).Row
temp1 = 0
For i = 2 To (rowscount1)
'Counting the number of cells which value greater than zero
If .Cells(i, 10) > 0 Then
temp1 = temp1 + 1
End If
Next i
'Summing up the values which are above the current cell and in Sheet1, this inclues negative numbers as well
.Cells(rowscount + 1, 9).Value = Application.Sum(.Range(.Cells(1, 9), .Cells(rowscount, 9)))
.Cells(rowscount + 2, 9) = temp
.Cells(rowscount1 + 1, 10).Value = Application.Sum(.Range(.Cells(1, 10), .Cells(rowscount1, 10)))
.Cells(rowscount1 + 2, 10) = temp1
'copy ke sheet 1
End If
End With
Next ws
End Sub
The problem is you're not referencing the object correctly.
Try fully qualifying your objects by using With Statement.
For Each ws In Thisworkbook.Worksheets
With ws 'add With statement to explicitly reference ws object
'precede all properties with a dot from here on
If .Name <> "Sheet1" Then
rowscount = .Cells(.Rows.Count, 1).End(xlUp).Row 'notice the dots
temp = 0
'~~> do the same with the rest of the code
End If
End With
Next
i'm a complete noob in vba so i'm searching all over the net to combine the code but right now it seems i hit the great wall and can't get it right. what i wanna do are:
to sum every row above and add extra row above (somehow i get this
right)
in extra row (i said above) i want to count every cells above that have value more than zero (in excel i use simple count if formula but i cant do it in vba)
to loop the step above in another sheet in this workbook except sheet 1 (the quantity of sheets can vary depend on the input, so i believe this can be done by loop but i dont know how)
to copy the output of the step above into sheet 1
this is my code so far and since i cant do loop i did it manualy for sheet2 and sheet3. i get stuck in step 2
here is the code that've been modified taken from #NEOman' code
Sub Copy_Sum()
Dim ws As Worksheet
'Selecting the worksheets to loop through
K = 1
For Each ws In ThisWorkbook.Worksheets
'Skiping the sheet1
If ws.Name <> "Sheet1" Then
'Counting the number of rows for automation
rowscount = Cells(Rows.Count, 1).End(xlUp).Row
temp = 0
'Looping throught the cells for the calculation
For j = 2 To (rowscount)
'Counting the number of cells which value greater than zero
If Cells(j, 9) > 0 Then
temp = temp + 1
End If
Next j
'Counting the number of rows for automation
rowscount1 = Cells(Rows.Count, 1).End(xlUp).Row
temp1 = 0
For i = 2 To (rowscount1)
'Counting the number of cells which value greater than zero
If Cells(i, 10) > 0 Then
temp1 = temp1 + 1
End If
Next i
'Summing up the values which are above the current cell and in Sheet1, this inclues negative numbers as well
Cells(rowscount + 1, 9).Value = Application.Sum(Range(Cells(1, 9), Cells(rowscount, 9)))
Cells(rowscount + 2, 9) = temp
'copy ke sheet 1
Worksheets("Sheet1").Cells(K, 1).Value = Cells(rowscount + 1, 1).Value
Worksheets("Sheet1").Cells(K, 2).Value = temp
K = K + 1
Cells(rowscount1 + 1, 10).Value = Application.Sum(Range(Cells(1, 10), Cells(rowscount1, 10)))
Cells(rowscount1 + 2, 10) = temp1
'copy ke sheet 1
Worksheets("Sheet1").Cells(rowscount1 + K, rowscount1 + 1).Value = Cells(rowscount1 + 2, 1).Value
Worksheets("Sheet1").Cells(rowscount1 + K, rowscount1 + 2).Value = temp1
K = K + 1
End If
Next ws
End Sub
i know my code is a mess and i wrote comment in every step i did so that i know what the codes are doing. i use different code for column I and J but neither works :(. any help will be appreciated, thanks in advance for your attention.
===========================================================================================
the code must be run in every sheet (except sheet1) manualy, so im still trying to make the code run from sheet1 but work on any other sheet in same workbook. any help will be appreciated, thanks in advance for your attention.
Sub Copy_Sum()
Dim ws As Worksheet
'Selecting the worksheets to loop through
K = 1
For Each ws In ThisWorkbook.Worksheets
'Skiping the sheet1
If ws.Name <> "Sheet1" Then
'Counting the number of rows for automation
rowsCount = Cells(Rows.Count, 1).End(xlUp).Row
temp = 0
'Looping throught the cells for the calculation
For j = 2 To (rowsCount)
'Counting the number of cells which value greater than zero
If Cells(j - 1, 1) > 0 Then
temp = temp + 1
End If
Next j
'Summing up the values which are above the current cell and in Sheet1, this inclues negative numbers as well
Cells(rowsCount + 1, 1).Value = Application.Sum(Range(Cells(1, 1), Cells(rowsCount, 1)))
Cells(rowsCount + 1, 2) = temp
Worksheets("Sheet1").Cells(K, 1).Value = Cells(rowsCount + 1, 1).Value
Worksheets("Sheet1").Cells(K, 2).Value = temp
K = K + 1
End If
Next ws
End Sub