I'm trying to find all rows in a single column with the same value. The program should delete all rows that occur multiple times, apart from one of the columns, which should contract all statements from the deleted rows. This is what I have so far, but I'm getting a loop error:
Sub tester()
Sheets("Sheet1").Select
Dim one As Integer
one = 2
Dim log As Integer
log = 2
Dim compare As Integer
compare = one + 1
Dim ws As String
ws = "Sheet1"
Dim ender As String
ender = "Sheet4"
Dim counter As Integer
counter = 0
Dim lastrow As Integer
lastrow = Cells(Rows.Count, 1).End(xlUp).row
For log = 2 To lastrow - 1
one = log + counter
compare = one + 1
If Worksheets(ws).Cells(one, 1).Value = Worksheets(ws).Cells(compare,1).Value And Worksheets(ws).Cells(one, 7).Value = Worksheets(ws).Cells(compare, 7).Value Then
Do While Worksheets(ws).Cells(one, 1).Value = Worksheets(ws).Cells(compare, 1).Value And Worksheets(ws).Cells(one, 7).Value = Worksheets(ws).Cells(compare, 7).Value
If compare = one + 1 Then
Worksheets(ender).Cells(log, 1).Value = Worksheets(ws).Cells(one, 1).Value
Worksheets(ender).Cells(log, 4).Value = Worksheets(ws).Cells(one, 4).Value
Worksheets(ender).Cells(log, 2).Value = Worksheets(ws).Cells(one, 2).Value
Worksheets(ender).Cells(log, 7).Value = Worksheets(ws).Cells(one, 7).Value
End If
Worksheets(ender).Cells(log, 4).Value = Worksheets(ender).Cells(log, 4).Value & "; " & Worksheets(ws).Cells(compare, 4).Value
compare = compare + 1
counter = counter + 1
Loop
ElseIf Worksheets(ws).Cells(one, 1).Value <> Worksheets(ws).Cells(compare, 1).Value Then
Worksheets(ender).Cells(one - counter, 1).Value = Worksheets(ws).Cells(one, 1).Value
Worksheets(ender).Cells(one - counter, 2).Value = Worksheets(ws).Cells(one, 2).Value
Worksheets(ender).Cells(one - counter, 3).Value = Worksheets(ws).Cells(one, 3).Value
Worksheets(ender).Cells(one - counter, 4).Value = Worksheets(ws).Cells(one, 4).Value
Worksheets(ender).Cells(one - counter, 5).Value = Worksheets(ws).Cells(one, 5).Value
Worksheets(ender).Cells(one - counter, 7).Value = Worksheets(ws).Cells(one, 7).Value
End If
Next log
Sheets("Sheet4").Select
End Sub
Original Data
Desired output
Related
I just can't seem to get this for loop running correctly. I know that I missing something basic, but I just can't figure it.
I have 2 tables.
Table 1 : (Table starts at row 7, and columns i to q are hidden)
Table 2 :
My goal is to pull new rows from Table1 to Table2.
My code rolls through Table 1, identifies the rows with an 'R' value, and fills them.
Then I want to pull data from those same rows to Table2
The code that identifies and fills the 'R' value:
Dim iRow As Long
With Sheet12
iRow = Application.Count(.ListObjects("Table1").ListColumns("KEY").DataBodyRange)
End With
'find last row with a date
Dim jRow As Long
With Sheet12
jRow = Application.Count(.ListObjects("Table1").ListColumns("Date").DataBodyRange)
End With
'take the value from iRow and col 1, add 1, place in iRow+1,1
Dim q As Long
For q = iRow + 7 To jRow + 6
Sheet12.Cells(q, 18) = 1 + Sheet12.Cells(q - 1, 18)
Next q
Then this bit I'm having trouble with. My thought was try to run a double loop, where I loop through to fill each column and then each row.
Dim a As Long
Dim b As Long
Dim c As Long
c = jRow - iRow
For b = 11 To c + 11
For a = iRow + 7 To jRow + 6
ws15.Cells(b, 1).Value = "Plaid-" & Sheet12.Cells(a, 8).Value & "-" & Sheet12.Cells(a, 7).Value
ws15.Cells(b, 2).Value = Sheet12.Cells(a, 18).Value
ws15.Cells(b, 3).Value = Sheet12.Cells(a, 3).Value
ws15.Cells(b, 4).Value = Sheet12.Cells(a, 4).Value
ws15.Cells(b, 5).Value = Sheet12.Cells(a, 5).Value
ws15.Cells(b, 6).Value = 1001
ws15.Cells(b, 7).Value = "FILL IN"
Next a
Next b
Now the above code only copies the last row from Table1 into Table2 four times.
I know I'm close, and I'm sure I'm just tired, but I can't get it right. I appreciate everyone's time.
The double loop is causing the problem. The inside loop fills in the same row 4 times. This explains why every row has the same data.
You want to iterate the rows together so you just need 1 loop. The b variable is not needed.
Try this code:
Dim a As Long
Dim c As Long
c = jRow - iRow + 7 'start row on new sheet
For a = iRow + 7 To jRow + 6 'source data rows
ws15.Cells(c, 1).Value = "Plaid-" & Sheet12.Cells(a, 8).Value & "-" & Sheet12.Cells(a, 7).Value
ws15.Cells(c, 2).Value = Sheet12.Cells(a, 18).Value
ws15.Cells(c, 3).Value = Sheet12.Cells(a, 3).Value
ws15.Cells(c, 4).Value = Sheet12.Cells(a, 4).Value
ws15.Cells(c, 5).Value = Sheet12.Cells(a, 5).Value
ws15.Cells(c, 6).Value = 1001
ws15.Cells(c, 7).Value = "FILL IN"
c = c + 1 'next row on new sheet
Next a
I am a complete novice at Excel VBA and I am currently attempting a project on Excel VBA. I have created a UserForm that would allow the user to enter data onto the Excel Sheet by completing the fields in the UserForm. I have tested all the codes individually and they have worked fine.
For the user to access the UserForm, I have added an ActiveX Command Button on a separate sheet on the same workbook. However, when accessing the UserForm from the ActiveX Command Button, some of the codes do not run (mainly the code that flags out the duplicate entry, as well as the code that generates serial numbers).
Where did I go wrong in my code?
This is my code to adding new data as well as the code to flag out duplicate entries. When opening the UserForm from the ActiveX Command Button, adding new data works fine but it does not flag out duplicate entries in the data. (However, testing the code itself in VBA works perfectly fine).
Private Sub cmdAddNewCustomer_Click()
Dim count As Long
Dim lastrow As Long
Dim lCustomerID As String
Dim ws As Worksheet
Set ws = Worksheets("Customer Data")
'find first empty row in database
lrow = ws.Cells.Find(what:="*", searchorder:=xlRows, _
Searchdirection:=xlPrevious, LookIn:=xlValues).Row + 1
lCustomerID = txtCustomerID
count = 0
With ws
For currentrow = 1 To lrow
If lCustomerID = Cells(currentrow, 1) Then
count = count + 1
End If
If count > 1 Then
.Cells(currentrow, 1).Value = ""
.Cells(currentrow, 2).Value = ""
.Cells(currentrow, 3).Value = ""
.Cells(currentrow, 4).Value = ""
.Cells(currentrow, 5).Value = ""
.Cells(currentrow, 6).Value = ""
.Cells(currentrow, 7).Value = ""
.Cells(currentrow, 8).Value = ""
.Cells(currentrow, 9).Value = ""
.Cells(currentrow, 10).Value = ""
.Cells(currentrow, 11).Value = ""
.Cells(currentrow, 12).Value = ""
.Cells(currentrow, 13).Value = ""
.Cells(currentrow, 14).Value = ""
MsgBox ("CustomerID already exists!")
End If
If count = 0 Then
.Cells(lrow, 1).Value = Me.txtCustomerID.Value
.Cells(lrow, 2).Value = Me.txtCustomerName.Value
.Cells(lrow, 3).Value = Me.cboCustomerStatus.Value
.Cells(lrow, 4).Value = Me.txtContactPerson.Value
.Cells(lrow, 5).Value = Me.cboDepartment.Value
.Cells(lrow, 6).Value = Me.txtPosition.Value
.Cells(lrow, 7).Value = Me.cboRoleType.Value
.Cells(lrow, 8).Value = Me.txtofficeHP1.Value
.Cells(lrow, 9).Value = Me.txtOfficeHP2.Value
.Cells(lrow, 10).Value = Me.txtMobileHP1.Value
.Cells(lrow, 11).Value = Me.txtMobileHP2.Value
.Cells(lrow, 12).Value = Me.txtEmail1.Value
.Cells(lrow, 13).Value = Me.txtEmail2.Value
.Cells(lrow, 14).Value = Me.txtEmail3.Value
End If
Next currentrow
End With
'clear the data
Me.txtCustomerName.Value = ""
Me.cboCustomerStatus.Value = ""
Me.txtContactPerson.Value = ""
Me.cboDepartment.Value = ""
Me.txtPosition.Value = ""
Me.cboRoleType.Value = ""
Me.txtofficeHP1.Value = ""
Me.txtOfficeHP2.Value = ""
Me.txtMobileHP1.Value = ""
Me.txtMobileHP2.Value = ""
Me.txtEmail1.Value = ""
Me.txtEmail2.Value = ""
Me.txtEmail3.Value = ""
End Sub
This is the code to generate serial numbers. (Same problem, does not work when accessed via ActiveX Command Button but works fine when tested individually in VBA).
Sub FindCustomerID()
Dim lastrow
Dim lastnum As Long
Dim ws As Worksheet
Set ws = Worksheets("Customer Data")
If Me.cboCountry = "" Or Me.txtCustomerName = "" Then
Exit Sub
End If
serialno = 1
lastrow = ws.Cells(Rows.count, 1).End(xlUp).Row
CountryCode = UCase(Left(Me.cboCountry, 3))
CustomerCode = UCase(Left(Me.txtCustomerName, 10))
'assemble them into CustomerID
CustomerID = CountryCode & CustomerCode & serialno
For currentrow = 2 To lastrow
If CustomerID = Cells(currentrow, 1) Then
'find last number that applies
serialno = serialno + 1
End If
're-assign customerID with new serial number
CustomerID = CountryCode & CustomerCode & serialno
Next currentrow
Me.lblCustomerID = CustomerID
End Sub
And lastly, this is the code from the ActiveX Command Button that brings out the UserForm.
Private Sub cmdNCustomerData_Click()
frmCustomerdata.Show
End Sub
The cause of the problem you described is a missing . to qualify Cells(currentrow, 1). Because you added the ActiveX button to a different sheet, the line
If lCustomerID = Cells(currentrow, 1) Then
accesses Cells(currentrow, 1) of that sheet. To fix this the range needs to be qualified with a . to become
If lCustomerID = .Cells(currentrow, 1) Then
I would also take
If count = 0 Then
.
.
.
End If
outside the loop. You are repeating these lines many times unnecessarily.
The first block of code then becomes:
Private Sub cmdAddNewCustomer_Click()
Dim count As Long
Dim lastrow As Long
Dim lCustomerID As String
Dim ws As Worksheet
Set ws = Worksheets("Customer Data")
'find first empty row in database
lrow = ws.Cells.Find(what:="*", searchorder:=xlRows, _
Searchdirection:=xlPrevious, LookIn:=xlValues).Row + 1
lCustomerID = txtCustomerID
count = 0
With ws
' Count backward to delete rows completely
For currentrow = lrow - 1 To 1 Step -1
If lCustomerID = .Cells(currentrow, 1) Then
count = count + 1
End If
If count > 1 Then
.Cells(currentrow, 1).Resize(1, 14).ClearContents
' Uncomment the following line to delete the whole row completely
'.Rows(currentrow).Delete
End If
Next currentrow
If count > 1 Then
MsgBox (count - 1 " duplicates of CustomerID found and cleared!")
ElseIf count = 0 Then
.Cells(lrow, 1).Value = Me.txtCustomerID.Value
.Cells(lrow, 2).Value = Me.txtCustomerName.Value
.Cells(lrow, 3).Value = Me.cboCustomerStatus.Value
.Cells(lrow, 4).Value = Me.txtContactPerson.Value
.Cells(lrow, 5).Value = Me.cboDepartment.Value
.Cells(lrow, 6).Value = Me.txtPosition.Value
.Cells(lrow, 7).Value = Me.cboRoleType.Value
.Cells(lrow, 8).Value = Me.txtofficeHP1.Value
.Cells(lrow, 9).Value = Me.txtOfficeHP2.Value
.Cells(lrow, 10).Value = Me.txtMobileHP1.Value
.Cells(lrow, 11).Value = Me.txtMobileHP2.Value
.Cells(lrow, 12).Value = Me.txtEmail1.Value
.Cells(lrow, 13).Value = Me.txtEmail2.Value
.Cells(lrow, 14).Value = Me.txtEmail3.Value
End If
End With
'clear the data
Me.txtCustomerName.Value = ""
Me.cboCustomerStatus.Value = ""
Me.txtContactPerson.Value = ""
Me.cboDepartment.Value = ""
Me.txtPosition.Value = ""
Me.cboRoleType.Value = ""
Me.txtofficeHP1.Value = ""
Me.txtOfficeHP2.Value = ""
Me.txtMobileHP1.Value = ""
Me.txtMobileHP2.Value = ""
Me.txtEmail1.Value = ""
Me.txtEmail2.Value = ""
Me.txtEmail3.Value = ""
End Sub
In the FindCustomerID subroutine you have exactly the same problem with the line
If CustomerID = Cells(currentrow, 1) Then
as Cells(currentrow, 1) is not qualified and therefore, should become
If CustomerID = ws.Cells(currentrow, 1) Then
You are also reassigning the CustomerID many times unnecessarily. I would take the reassignment inside the If statement and the loop will become
For currentrow = 2 To lastrow
If CustomerID = ws.Cells(currentrow, 1) Then
'find last number that applies
serialno = serialno + 1
're-assign customerID with new serial number
CustomerID = CountryCode & CustomerCode & serialno
End If
Next currentrow
This way CustomerID is only reassigned if and only if serialno changes.
Pic 2 shows what the solution should be and Pic 1 shows what my code has given me, the differences occur in the "Yearly Change","Percent Change" and "Total Stock Volume" columns.
The loop I created works for all the sheets but my figures in those specified column are off, can I get help in rectifying my code attached to get numbers similar to Pic 2? Thank you
Option Explicit
Sub Stockmarket()
'Declare and set worksheet
Dim ws As Worksheet
'Loop through all stocks for one year
For Each ws In Worksheets
'Create the column headings
ws.Range("I1").Value = "Ticker"
ws.Range("J1").Value = "Yearly Change"
ws.Range("K1").Value = "Percent Change"
ws.Range("L1").Value = "Total Stock Volume"
ws.Range("P1").Value = "Ticker"
ws.Range("Q1").Value = "Value"
ws.Range("O2").Value = "Greatest % Increase"
ws.Range("O3").Value = "Greatest % Decrease"
ws.Range("O4").Value = "Greatest Total Volume"
'Define Ticker variable
Dim Ticker As String
'Set initial and last row for worksheet
Dim Lastrow As Long
Dim i As Long
Dim j As Integer
Dim x As Double
j = 2
x = 2
'Define Lastrow of worksheet
Lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
'Set new variables for prices and percent changes
Dim open_price As Double
'open_price = 0
Dim close_price As Double
'close_price = 0
Dim price_change As Double
'price_change = 0
Dim price_change_percent As Double
'price_change_percent = 0
'Create variable to keep the ticker row in
Dim TickerRow As Long
TickerRow = 1
Dim stock_volume As Double
stock_volume = 0
'Do loop of current worksheet to Lastrow
For i = 2 To Lastrow
'Ticker symbol output
If ws.Cells(i + 1, 1).Value <> ws.Cells(i, 1).Value Then
TickerRow = TickerRow + 1
Ticker = ws.Cells(i, 1).Value
ws.Cells(TickerRow, "I").Value = Ticker
'Stock Volume output
If ws.Cells(i, 1).Value = ws.Cells(i + 1, 1).Value Then
stock_volume = stock_volume + ws.Cells(i, 7).Value
ElseIf ws.Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
stock_volume = stock_volume + ws.Cells(i, 7).Value
ws.Cells(j, 9).Value = ws.Cells(i, 1).Value
ws.Cells(j, 12).Value = stock_volume
j = j + 1
stock_volume = 0
End If
'Creating the Yearly change and Percent change output
open_price = ws.Cells(i, 3).Value
close_price = ws.Cells(i, 6).Value
ws.Cells(x, 10).Value = open_price - close_price
If close_price <= 0 Then
ws.Cells(x, 11).Value = 0
Else
ws.Cells(x, 11).Value = (close_price / open_price) - 1
End If
ws.Cells(x, 11).Style = "Percent"
If ws.Cells(x, 10).Value >= 0 Then
ws.Cells(x, 10).Interior.ColorIndex = 4
Else
ws.Cells(x, 10).Interior.ColorIndex = 3
End If
x = x + 1
ws.Cells(x, 9).Value = ws.Cells(i, 1).Value
ws.Cells(x, 10).Value = close_price - open_price
If close_price <= 0 Then
ws.Cells(x, 11).Value = 0
Else
ws.Cells(x, 11).Value = (close_price / open_price) - 1
End If
ws.Cells(x, 11).Style = "Percent"
If ws.Cells(x, 10).Value >= 0 Then
ws.Cells(x, 10).Interior.ColorIndex = 4
Else
ws.Cells(x, 10).Interior.ColorIndex = 3
End If
End If
Next i
Next ws
End Sub
You seem to have a logic problem - see the two marked lines below
'Ticker symbol output
If ws.Cells(i + 1, 1).Value <> ws.Cells(i, 1).Value Then '<<<<<<<<<
TickerRow = TickerRow + 1
Ticker = ws.Cells(i, 1).Value
ws.Cells(TickerRow, "I").Value = Ticker
'Stock Volume output
If ws.Cells(i, 1).Value = ws.Cells(i + 1, 1).Value Then '<<< never true!
stock_volume = stock_volume + ws.Cells(i, 7).Value
ElseIf ws.Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
stock_volume = stock_volume + ws.Cells(i, 7).Value
ws.Cells(j, 9).Value = ws.Cells(i, 1).Value
ws.Cells(j, 12).Value = stock_volume
j = j + 1
stock_volume = 0
End If
I want to add new data to a table with a form. I have it adding data at the bottom of the sheet.
I want the new info at the top.
With my code, it sends the data to two sheets, the "home" sheet and the sheet that is selected in the first combo box.
Private Sub CommandButton1_Click()
TargetSheet = ComboBox1.Value
If TargetSheet = "" Then
Exit Sub
End If
Worksheets(TargetSheet).Activate
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Cells(lastrow + 1, 1).Value = TextBox1.Value
ActiveSheet.Cells(lastrow + 1, 2).Value = TextBox2.Value
ActiveSheet.Cells(lastrow + 1, 3).Value = TextBox3.Value
ActiveSheet.Cells(lastrow + 1, 4).Value = TextBox4.Value
ActiveSheet.Cells(lastrow + 1, 5).Value = TextBox5.Value
ActiveSheet.Cells(lastrow + 1, 6).Value = TextBox6.Value
ActiveSheet.Cells(lastrow + 1, 7).Value = TextBox7.Value
ActiveSheet.Cells(lastrow + 1, 8).Value = TextBox8.Value
Worksheets("Home").Activate
lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Cells(lastrow + 1, 1).Value = ComboBox1.Value
ActiveSheet.Cells(lastrow + 1, 2).Value = TextBox1.Value
ActiveSheet.Cells(lastrow + 1, 3).Value = TextBox2.Value
ActiveSheet.Cells(lastrow + 1, 4).Value = TextBox3.Value
ActiveSheet.Cells(lastrow + 1, 5).Value = TextBox4.Value
ActiveSheet.Cells(lastrow + 1, 6).Value = TextBox5.Value
ActiveSheet.Cells(lastrow + 1, 7).Value = TextBox6.Value
ActiveSheet.Cells(lastrow + 1, 8).Value = TextBox7.Value
ActiveSheet.Cells(lastrow + 1, 9).Value = TextBox8.Value
ActiveSheet.Cells(lastrow + 1, 10).Value = Date
ActiveSheet.Cells(lastrow + 1, 11).Value = TimeValue(Now)
ActiveSheet.Cells(lastrow + 1, 12).Value = TextBox9.Value
MsgBox ("Item Added Successfully.")
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
Worksheets("Home").Activate
Worksheets("Home").Cells(1, 1).Select
End Sub
How do I put the new data in the second row since I have headers on the sheet?
There are a lot of stuff to improve your my code, but I want to keep it simple
Some things to begin:
Use option explicit so you don't have unexpected behavior with undefined variables
Always indent your code (see www.rubberduckvba.com a free tool that helps you with that)
Try to separate your logic defining variables and the reusing them
Name your forms' controls
Check a great article about UserForms (when you feel you're ready to advance)
Check the code's comments, and adapt it to fit your needs
EDIT: No need for the EntireRow qualifier as we are already selecting the whole row, and added the copy format from below
Code:
Private Sub CommandButton1_Click()
' Define object variables
Dim targetSheet As Worksheet
Dim homeSheet As Worksheet
Dim targetSheetName As String
Dim homeSheetName As String
Dim targetSheetTopRow As Long
Dim homeSheetTopRow As Long
Dim textBox1Value As Variant
Dim textBox2Value As Variant
Dim textBox3Value As Variant
Dim textBox4Value As Variant
Dim textBox5Value As Variant
Dim textBox6Value As Variant
Dim textBox7Value As Variant
Dim textBox8Value As Variant
Dim textBox9Value As Variant
' Define parameters
targetSheetTopRow = 2
homeSheetTopRow = 2
homeSheetName = "Home"
' Validate if combobox has any value
If Me.ComboBox1.Value = vbNullString Then Exit Sub
' Get target sheet name
targetSheetName = Me.ComboBox1.Value
' Add a reference to sheets
Set targetSheet = ThisWorkbook.Worksheets(targetSheetName)
Set homeSheet = ThisWorkbook.Worksheets(homeSheetName)
' Store current controls values
textBox1Value = Me.TextBox1.Value
textBox2Value = Me.TextBox2.Value
textBox3Value = Me.TextBox3.Value
textBox4Value = Me.TextBox4.Value
textBox5Value = Me.TextBox5.Value
textBox6Value = Me.TextBox6.Value
textBox7Value = Me.TextBox7.Value
textBox8Value = Me.TextBox8.Value
' No need to activate stuff
With targetSheet
' Insert a row after row 2
.Range(targetSheetTopRow & ":" & targetSheetTopRow).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
' Add cells values
.Cells(targetSheetTopRow, 1).Value = textBox1Value
.Cells(targetSheetTopRow, 2).Value = textBox2Value
.Cells(targetSheetTopRow, 3).Value = textBox3Value
.Cells(targetSheetTopRow, 4).Value = textBox4Value
.Cells(targetSheetTopRow, 5).Value = textBox5Value
.Cells(targetSheetTopRow, 6).Value = textBox6Value
.Cells(targetSheetTopRow, 7).Value = textBox7Value
.Cells(targetSheetTopRow, 8).Value = textBox8Value
End With
With homeSheet
' Insert a row after row 2
.Range(homeSheetTopRow & ":" & homeSheetTopRow).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
' Add cells values
.Cells(homeSheetTopRow, 1).Value = textBox1Value
.Cells(homeSheetTopRow, 2).Value = textBox2Value
.Cells(homeSheetTopRow, 3).Value = textBox3Value
.Cells(homeSheetTopRow, 4).Value = textBox4Value
.Cells(homeSheetTopRow, 5).Value = textBox5Value
.Cells(homeSheetTopRow, 6).Value = textBox6Value
.Cells(homeSheetTopRow, 7).Value = textBox7Value
.Cells(homeSheetTopRow, 8).Value = textBox8Value
.Cells(homeSheetTopRow, 9).Value = Date
.Cells(homeSheetTopRow, 10).Value = TimeValue(Now)
.Cells(homeSheetTopRow, 11).Value = textBox9Value
End With
' Clear control's values
Me.TextBox1.Value = vbNullString
Me.TextBox2.Value = vbNullString
Me.TextBox3.Value = vbNullString
Me.TextBox4.Value = vbNullString
' Alert user
MsgBox ("Item Added Successfully.")
' Goto...
homeSheet.Activate
homeSheet.Cells(1, 1).Select
End Sub
Let me know if it works or you need more help
How I can refer to Worksheets("Customers") without activating the worksheet in the below code?
Application.ScreenUpdating does not do the job, as there is still annoying flickering.
The code is working fine when I uncomment 'Worksheets("Customers").Activate
I want to perform all steps when Worksheets("Dashboard") is open.
I have tried "With ... End With" but no luck., also referencing Worksheets("Customers").Cells..... etc are not working. Its like code skipping through the code and goes straight to
"
If SearchRow = 2 Then
MsgBox "Customer Not Found", vbExclamation
Exit Sub
End If
"
I also have another code similar issue, that for some reason referencing not working as it should.
Just want to mention that I am using this code with the userforms and click buttons.
Any help will be appreciated.
Private Sub srCus_Click()
Application.ScreenUpdating = False
Dim RowNum As Long
Dim SearchRow As Long
RowNum = 2
SearchRow = 2
Worksheets("SearchCus").Range("A2:I100").ClearContents
'Worksheets("Customers").Activate
Do Until Worksheets("Customers").Cells(RowNum, 1).Value = ""
If InStr(1, Cells(RowNum, 3).Value, CusDB.Value, vbTextCompare) > 0 Then
Worksheets("SearchCus").Cells(SearchRow, 1).Value = Cells(RowNum, 1).Value
Worksheets("SearchCus").Cells(SearchRow, 2).Value = Cells(RowNum, 2).Value
Worksheets("SearchCus").Cells(SearchRow, 3).Value = Cells(RowNum, 3).Value
Worksheets("SearchCus").Cells(SearchRow, 4).Value = Cells(RowNum, 4).Value
Worksheets("SearchCus").Cells(SearchRow, 5).Value = Cells(RowNum, 5).Value
Worksheets("SearchCus").Cells(SearchRow, 6).Value = Cells(RowNum, 6).Value
Worksheets("SearchCus").Cells(SearchRow, 7).Value = Cells(RowNum, 7).Value
Worksheets("SearchCus").Cells(SearchRow, 8).Value = Cells(RowNum, 8).Value
Worksheets("SearchCus").Cells(SearchRow, 9).Value = Cells(RowNum, 9).Value
SearchRow = SearchRow + 1
End If
RowNum = RowNum + 1
Loop
If SearchRow = 2 Then
MsgBox "Customer Not Found", vbExclamation
Exit Sub
End If
ResultsDB.RowSource = "SearchResults"
'ThisWorkbook.Worksheets("Dashboard").Activate
Application.ScreenUpdating = True
End Sub
Thanks SJR, You were right with reference to all these Cells(RowNum, 1), I was always skipping one with InStr line. Thanks for the help and all suggestions. Reviewed code below.
Private Sub srCus_Click()
Application.ScreenUpdating = False
Dim RowNum As Long
Dim SearchRow As Long
RowNum = 2
SearchRow = 2
Worksheets("SearchCus").Range("A2:I100").ClearContents
'Worksheets("Customers").Activate
Do Until Worksheets("Customers").Cells(RowNum, 1).Value = ""
If InStr(1, Worksheets("Customers").Cells(RowNum, 3).Value, CusDB.Value, vbTextCompare) > 0 Then
Worksheets("SearchCus").Cells(SearchRow, 1).Value = Worksheets("Customers").Cells(RowNum, 1).Value
Worksheets("SearchCus").Cells(SearchRow, 2).Value = Worksheets("Customers").Cells(RowNum, 2).Value
Worksheets("SearchCus").Cells(SearchRow, 3).Value = Worksheets("Customers").Cells(RowNum, 3).Value
Worksheets("SearchCus").Cells(SearchRow, 4).Value = Worksheets("Customers").Cells(RowNum, 4).Value
Worksheets("SearchCus").Cells(SearchRow, 5).Value = Worksheets("Customers").Cells(RowNum, 5).Value
Worksheets("SearchCus").Cells(SearchRow, 6).Value = Worksheets("Customers").Cells(RowNum, 6).Value
Worksheets("SearchCus").Cells(SearchRow, 7).Value = Worksheets("Customers").Cells(RowNum, 7).Value
Worksheets("SearchCus").Cells(SearchRow, 8).Value = Worksheets("Customers").Cells(RowNum, 8).Value
Worksheets("SearchCus").Cells(SearchRow, 9).Value = Worksheets("Customers").Cells(RowNum, 9).Value
SearchRow = SearchRow + 1
End If
RowNum = RowNum + 1
Loop
If SearchRow = 2 Then
MsgBox "Customer Not Found", vbExclamation
Exit Sub
End If
ResultsDB.RowSource = "SearchResults"
'ThisWorkbook.Worksheets("Dashboard").Activate
Application.ScreenUpdating = True
End Sub