Macro not working in personal.xls

[dibaghish]

Is there a special rule in using call procedure macros in a
personal.xls project vs. a VBAproject assigned to a specific
worksheet? The following macro allows me to search col 3 until the
data runs out & parse out certain characters into col 4. This works
when the macro is setup for a specific but fails to run or give an
error when it's in personal.xls module. I have tried this in both
2003 & 2007 versions of excel. I would appreciate any help. Thanks.

Sub AccountType()
Dim s1 As Sheet1
Dim row As Integer
Dim sTemp As String

Set s1 = Sheet1

row = 4

Do Until s1.Cells(row, 1) = ""
sTemp = s1.Cells(row, 3)
sTemp = Right(sTemp, Len(sTemp) - 4)
s1.Cells(row, 4).Value = sTemp
row = row + 1
Loop
End Sub

 

[Vergel Adriano]

Hi,

Try it this way:

Sub AccountType()
Dim s1 As Sheet
Dim row As Integer
Dim sTemp As String

Set s1 = ActiveWorkbook.Sheets("Sheet1")

row = 4

Do Until s1.Cells(row, 1) = ""
sTemp = s1.Cells(row, 3)
sTemp = Right(sTemp, Len(sTemp) - 4)
s1.Cells(row, 4).Value = sTemp
row = row + 1
Loop
End Sub

 

[dibaghish]

Hi,

Try it this way:

Sub AccountType()
Dim s1 As Sheet
Dim row As Integer
Dim sTemp As String

Set s1 = ActiveWorkbook.Sheets("Sheet1")

row = 4

Do Until s1.Cells(row, 1) = ""
sTemp = s1.Cells(row, 3)
sTemp = Right(sTemp, Len(sTemp) - 4)
s1.Cells(row, 4).Value = sTemp
row = row + 1
Loop
End Sub

--
Hope that helps.

Vergel Adriano









- Show quoted text -

Thx. Tried this & I get Compile error: User-defined type not defined
for: s1 As Sheet

 

[Dave Peterson]

How about:

Dim s1 As worksheet
'....
Set s1 = activesheet

I'm gonna guess that you want your code to run against the activesheet--no
matter what that sheet is (or where it is).

 

[JE McGimpsey]

There is no Sheet object. Use

Dim s1 As Worksheet

 

[dibaghish]

There is no Sheet object. Use

Dim s1 As Worksheet



- Show quoted text -

Thanks. That fixed it--though it runs a little slow.

 

[Vergel Adriano]

It should be

Dim s1 As WorkSheet

 

[JE McGimpsey]

You might try:

Public Sub AccountType()
Dim rCell As Range
On Error Resume Next
With Application
.EnableEvents = False
.Calculation = False
.ScreenUpdating = False
End With
With ActiveWorkbook.Sheets("Sheet1")
For Each rCell In .Range(.Cells(4, 3), _
.Cells(.Rows.Count, 3).End(xlUp))
With rCell
.Offset(0, 1).Value = Mid(.Text, 5)
End With
Next rCell
End With
With Application
.ScreenUpdating = True
.Calculation = True
.EnableEvents = True
End With
End Sub

 

[Dave Peterson]

If your values in C4:Cxxx are always text (no formulas), you could do:

Select the range
data|text to columns
fixed width
draw a line after the 4th character (and remove any other lines)
Do not import the first field
and import the second field as text
And change the destination to be on column to the right.

In code:

Option Explicit
Sub AccountType2()
Dim myRng As Range
Dim wks As Worksheet
Dim TopCell As Range
Dim BotCell As Range

Set wks = ActiveSheet

With wks
Set TopCell = .Range("C4")
Set BotCell = TopCell
If IsEmpty(TopCell.Offset(1, 0)) Then
Set BotCell = TopCell
ElseIf IsEmpty(TopCell.Offset(2, 0)) Then
Set BotCell = TopCell.Offset(1, 0)
Else
Set BotCell = TopCell.End(xlDown)
End If

.Range(TopCell, BotCell).TextToColumns _
Destination:=TopCell.Offset(0, 1), _
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 9), Array(4, 2))
End With

End Sub

 

[diba]

If your values in C4:Cxxx are always text (no formulas), you could do:

Select the range
data|text to columns
fixed width
draw a line after the 4th character (and remove any other lines)
Do not import the first field
and import the second field as text
And change the destination to be on column to the right.

In code:

Option Explicit
Sub AccountType2()
Dim myRng As Range
Dim wks As Worksheet
Dim TopCell As Range
Dim BotCell As Range

Set wks = ActiveSheet

With wks
Set TopCell = .Range("C4")
Set BotCell = TopCell
If IsEmpty(TopCell.Offset(1, 0)) Then
Set BotCell = TopCell
ElseIf IsEmpty(TopCell.Offset(2, 0)) Then
Set BotCell = TopCell.Offset(1, 0)
Else
Set BotCell = TopCell.End(xlDown)
End If

.Range(TopCell, BotCell).TextToColumns _
Destination:=TopCell.Offset(0, 1), _
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 9), Array(4, 2))
End With

End Sub

There is no Sheet object. Use
Dim s1 As Worksheet



--

Dave Peterson- Hide quoted text -

- Show quoted text -

Than you all for the suggestions. Yes, colC is all text so I can use
Dave's suggestion. Thx again.