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
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"
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
0
Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.
' 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
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
I don't know why I didn't get the error at all but here is the fix.
Sub FillInClassification()
Dim r As Range
Set r = Columns("P")
Set r = Intersect(r, ActiveSheet.UsedRange, Rows("2:65536"))
If Not r Is Nothing Then
For n = 1 To r.Cells.Count
Select Case r.Cells(n, 1).Value
Case "SYSACC"
r.Cells(n, 1).Offset(0, -1).Value = "This Works"
Case "GRAPHICS"
r.Cells(n, 1).Offset(0, -1).Value = "This Dont"
Case Else
End Select
Next n
End If
End Sub
HTH
dragontooth
0
SomtechAuthor Commented:
Thanks dragontooth this now works a treat.
Regards
Dave
0
Featured Post
Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!
Instead of
s.Row = r.Row
s.FormulaR1C1 = "ThisWorks"
try
s.Cells ( r.Row ) = "ThisWorks"