Simple Macro not working assistance required with code
Hi I am very new to VB programming and have been getting a little lost, I have the following problem
The spreadsheet that I have been working on contains a column called acccode which contains a code ( or should I say 1 of 150 different codes ) these relate to a top level category a second level category and a base level category. ie
Acccode = sysacc top level= Systems, second level = Computers, Base Level = Accounts Software
I have started to create a piece of code to
1. Create three blank columns to the left of sysacc column
2. Name each column
3. Search column J for sysacc and fill out g h i with the correct text
I have been able to create the columns and name them so have not included that code. The following is my code to fill in the data
Sub FillInClassification()
'
Dim r As Range
Dim s As Range
Set s = Columns("O")
Set r = Columns("P")
Set r = Intersect(r, ActiveSheet.UsedRange, Rows("2:65536"))
If r Is Nothing Then Exit Sub
For n = 2 To r.Rows.Count
Select Case r.Text
Case "SYSACC"
s.Row = r.Row
s.FormulaR1C1 = "ThisWorks"
Case "GRAPHICS"
Case Else
End Select
Next n
End Sub
When I try to run this I get the error "Wrong number of arguments or invalid property assignment" on the line s.Row = r.Row
all i am trying to do here is set the cell to the left of the one in colum P where the data is found so that i can run the next line to fill in the text. I was going to do the same again for Columns M and N
Any help will be greatly appreciated.
Regards
Dave
The spreadsheet that I have been working on contains a column called acccode which contains a code ( or should I say 1 of 150 different codes ) these relate to a top level category a second level category and a base level category. ie
Acccode = sysacc top level= Systems, second level = Computers, Base Level = Accounts Software
I have started to create a piece of code to
1. Create three blank columns to the left of sysacc column
2. Name each column
3. Search column J for sysacc and fill out g h i with the correct text
I have been able to create the columns and name them so have not included that code. The following is my code to fill in the data
Sub FillInClassification()
'
Dim r As Range
Dim s As Range
Set s = Columns("O")
Set r = Columns("P")
Set r = Intersect(r, ActiveSheet.UsedRange, Rows("2:65536"))
If r Is Nothing Then Exit Sub
For n = 2 To r.Rows.Count
Select Case r.Text
Case "SYSACC"
s.Row = r.Row
s.FormulaR1C1 = "ThisWorks"
Case "GRAPHICS"
Case Else
End Select
Next n
End Sub
When I try to run this I get the error "Wrong number of arguments or invalid property assignment" on the line s.Row = r.Row
all i am trying to do here is set the cell to the left of the one in colum P where the data is found so that i can run the next line to fill in the text. I was going to do the same again for Columns M and N
Any help will be greatly appreciated.
Regards
Dave
ASKER
Hi
I have changed my code as suggested to the following and although I no longer get an error I think my code must be flawed as I dont get the "ThisWorks" anywhere on the spreadsheet let alone in the correct place.
Sub FillInClassification()
'
Dim r As Range
Dim s As Range
Set s = Columns("O")
Set r = Columns("P")
Set r = Intersect(r, ActiveSheet.UsedRange, Rows("2:65536"))
If r Is Nothing Then Exit Sub
For n = 2 To r.Rows.Count
Select Case r.Text
Case "SYSACC"
s.Cells(r.Row) = "ThisWorks"
Case "GRAPHICS"
Case Else
End Select
Next n
End Sub
Any further assistance would be much appreciated
Dave
I have changed my code as suggested to the following and although I no longer get an error I think my code must be flawed as I dont get the "ThisWorks" anywhere on the spreadsheet let alone in the correct place.
Sub FillInClassification()
'
Dim r As Range
Dim s As Range
Set s = Columns("O")
Set r = Columns("P")
Set r = Intersect(r, ActiveSheet.UsedRange, Rows("2:65536"))
If r Is Nothing Then Exit Sub
For n = 2 To r.Rows.Count
Select Case r.Text
Case "SYSACC"
s.Cells(r.Row) = "ThisWorks"
Case "GRAPHICS"
Case Else
End Select
Next n
End Sub
Any further assistance would be much appreciated
Dave
Hi Somtech,
I revised your code as follows to work.
Sub FillInClassification()
'
Dim r As Range
Dim s As Range
Set s = Columns("O")
Set r = Columns("P")
Set r = Intersect(r, ActiveSheet.UsedRange, Rows("2:65536"))
If r Is Nothing Then Exit Sub
For n = 1 To r.Cells.Count 'we are working with cells not neccessarily rows
Select Case r.Cells.Value(n, 1)
Case "SYSACC"
s.Cells(n + 1, 1) = "ThisWorks"
Case "GRAPHICS"
s.Cells(n + 1, 1) = "ThisDont"
Case Else
End Select
Next n
End Sub
HTH
dragontooth
I revised your code as follows to work.
Sub FillInClassification()
'
Dim r As Range
Dim s As Range
Set s = Columns("O")
Set r = Columns("P")
Set r = Intersect(r, ActiveSheet.UsedRange, Rows("2:65536"))
If r Is Nothing Then Exit Sub
For n = 1 To r.Cells.Count 'we are working with cells not neccessarily rows
Select Case r.Cells.Value(n, 1)
Case "SYSACC"
s.Cells(n + 1, 1) = "ThisWorks"
Case "GRAPHICS"
s.Cells(n + 1, 1) = "ThisDont"
Case Else
End Select
Next n
End Sub
HTH
dragontooth
I missed the Intersect. This will make it work :)
Sub FillInClassification()
'
Dim r As Range
'Dim s As Range
' Set s = Columns("O")
Set r = Columns("P")
Set r = Intersect(r, ActiveSheet.UsedRange, Rows("2:65536"))
If r Is Nothing Then Exit Sub
For n = 1 To r.Cells.Count 'we are working with cells not neccessarily rows
Select Case r.Cells.Value(n, 1)
Case "SYSACC"
r.Cells(n, 1).Offset(, -1).Value = "ThisWorks"
's.Cells(n + 1, 1) = "ThisWorks"
Case "GRAPHICS"
r.Cells(n, 1).Offset(, -1).Value = "ThisDont"
's.Cells(n + 1, 1) = "ThisDont"
Case Else
End Select
Next n
End Sub
HTH
dragontooth
Sub FillInClassification()
'
Dim r As Range
'Dim s As Range
' Set s = Columns("O")
Set r = Columns("P")
Set r = Intersect(r, ActiveSheet.UsedRange, Rows("2:65536"))
If r Is Nothing Then Exit Sub
For n = 1 To r.Cells.Count 'we are working with cells not neccessarily rows
Select Case r.Cells.Value(n, 1)
Case "SYSACC"
r.Cells(n, 1).Offset(, -1).Value = "ThisWorks"
's.Cells(n + 1, 1) = "ThisWorks"
Case "GRAPHICS"
r.Cells(n, 1).Offset(, -1).Value = "ThisDont"
's.Cells(n + 1, 1) = "ThisDont"
Case Else
End Select
Next n
End Sub
HTH
dragontooth
Hi Somtech,
Do you require further assistance?
dragontooth
Do you require further assistance?
dragontooth
ASKER
Hi dragontooth
Sorry I was out of the office yesterday have tried the code as below and unfortunately get the following error
"Wrong number of arguments or invalid property assignment" with the .value portion of the Select Case r.cells.value(n,1) line highlighted.
Dim r As Range
Set r = Columns("P")
Set r = Intersect(r, ActiveSheet.UsedRange, Rows("2:65536"))
If r Is Nothing Then Exit Sub
For n = 1 To r.Cells.Count
Select Case r.Cells.Value(n, 1)
Case "SYSACC"
r.Cells(n, 1).Offset(, -1).Value = "ThisWorks"
Case "GRAPHICS"
r.Cells(n, 1).Offset(, -1).Value = "ThisDont"
Case Else
End Select
Next n
End Sub
Regards
Dave
Sorry I was out of the office yesterday have tried the code as below and unfortunately get the following error
"Wrong number of arguments or invalid property assignment" with the .value portion of the Select Case r.cells.value(n,1) line highlighted.
Dim r As Range
Set r = Columns("P")
Set r = Intersect(r, ActiveSheet.UsedRange, Rows("2:65536"))
If r Is Nothing Then Exit Sub
For n = 1 To r.Cells.Count
Select Case r.Cells.Value(n, 1)
Case "SYSACC"
r.Cells(n, 1).Offset(, -1).Value = "ThisWorks"
Case "GRAPHICS"
r.Cells(n, 1).Offset(, -1).Value = "ThisDont"
Case Else
End Select
Next n
End Sub
Regards
Dave
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks dragontooth this now works a treat.
Regards
Dave
Regards
Dave
Instead of
s.Row = r.Row
s.FormulaR1C1 = "ThisWorks"
try
s.Cells ( r.Row ) = "ThisWorks"