How to simplify vba code?

ChanL

New Member
Joined
Apr 8, 2021
Messages
17
Office Version
  1. 2019
Platform
  1. Windows
Hi, currently I'm working on a VBA code that I have to perform multiple task in a sheet namely "Sheet1".
I have wrote a code on it, but I feel like it is to length and need a way to refine it.
This is my code:
VBA Code:
Sub formatsheet()

'removedot
Sheets("Sheet1").Select
Sheets("Sheet1").Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace what:=".", replacement:=" ", lookat:=xlPart, searchorder:=xlByRows, MatchCase:=False, searchformat:=False, ReplaceFormat:=False, formulaversion:=xlReplaceFormula2

'insert I
Sheets("Sheet1").Select
Sheets("Sheet1").Range("B2").Select
Selection.Value = "I"
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select

'Fill country
Sheets("Sheet1").Select
Sheets("Sheet1").Range("G2").Value = "USA"
Range("G2").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("G2:G" & Range("A" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select

End Sub

The main reason why I keep repeating "Sheets("Sheet1").select" is because before this code, I actually have another code that need it to copy data from other sheets by refer to its header column. And when I didn't add "Sheets("Sheet1").select", it keep runs error.
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,187
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
MAybe this, but the other code may conflict without seeing it !!
VBA Code:
Sub formatsheet()
Dim lr As Long
lr = Sheets("Sheet1").Cells(Rows, Count, "A").End(xlUp).Row
With Sheets("Sheet1")
    .Range("A2:A" & lr).Replace what:=".", replacement:=" "
    .Range("B2:B" & lr).Value = "I"
    .Range("G2:G" & lr).Value = "USA"
End With
End Sub
 

ChanL

New Member
Joined
Apr 8, 2021
Messages
17
Office Version
  1. 2019
Platform
  1. Windows
MAybe this, but the other code may conflict without seeing it !!
VBA Code:
Sub formatsheet()
With Sheets("Sheet1")
    .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row).Replace what:=".", replacement:=" "
    .Range("B2:B" & .Range("A" & Rows.Count).End(xlUp).Row).Value = "I"
    .Range("G2:G" & .Range("A" & Rows.Count).End(xlUp).Row).Value = "USA"
End With
End Sub
Thanks so much for the reply! I always wanted to try use WITH function, but don't know how to simplify the code. By the way, this is the code that I run before running this.
VBA Code:
Sub getsource()

Application.ScreenUpdating = False

Dim closebook As Workbook

Set closebook = Workbooks.Open(Sheets("Main").Cells(3, 2).Value + "Own Transaction(OBMB).xlsx", True, True)
closebook.Sheets(1).Copy after:=ThisWorkbook.Sheets("Sheet1")
ActiveSheet.Name = "Fromsrc"
closebook.Close
savechanges = False

'Copy paste data
Dim lastrow As Long, header As Range, foundheader As Range, lcol As Long, source As Worksheet, destination As Worksheet

Set source = Sheets("Fromsrc")
Set destination = Sheets("Sheet1")

lastrow = source.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For Each header In destination.Cells(1, Columns.Count).End(xlToLeft).Column
    Set foundheader = source.Rows().Find(header, LookIn:=xlValues, lookat:=xlWhole)
    If Not foundheader Is Nothing Then
        source.Range(source.Cells(foundheader.Row + 1, foundheader.Column), source.Cells(lastrow, foundheader.Column)).Copy destination.cellls(2, header.Column)
    End If
    
    Next header
    
End Sub
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,187
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
It shouldn't be a problem with the code then !!
 

ChanL

New Member
Joined
Apr 8, 2021
Messages
17
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

It shouldn't be a problem with the code then !!
Thanks so much. I will try it out first!
If possible, I need your guidance on this one as well. Its a continuation part for sub formatsheet( )
VBA Code:
'format date

Sheets("Sheet1").Select
Sheets("Sheet1").Range("F2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "m/d/yyyy"
Selection.NumberFormat = "ddmmyyyy"
Selection.TextToColumns destination:=t = Range("F2"), DataType:=xlDelimited, _
semicolon:=False, comma:=False, Space:=False, other:=False, fieldinfo:=Array(1, 4) _
trailingminusnumbers:=true

This is to format the date. But I'm not sure how to corporate with the WITH function you show me , because the code is a bit long, and the "fieldinfo" part is super important to me as well.
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,187
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
VBA Code:
Sub formatsheet()
Dim lr As Long
lr = Sheets("Sheet1").Cells(Rows, Count, "A").End(xlUp).Row
With Sheets("Sheet1")
    .Range("A2:A" & lr).Replace what:=".", replacement:=" "
    .Range("B2:B" & lr).Value = "I"
    .Range("G2:G" & lr).Value = "USA"
    .Range("F2:F" & lr).NumberFormat = "ddmmyyyy"
    .TextToColumns Destination:=t = Range("F2"), DataType:=xlDelimited, _
    semicolon:=False, comma:=False, Space:=False, other:=False, fieldinfo:=Array(1, 4), _
    trailingminusnumbers:=True
End With
End Sub
But this bit doesn't makes sense
Rich (BB code):
.TextToColumns Destination:=t = Range("F2")
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,187
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows

ADVERTISEMENT

Maybe this way
Note I have change the destination here
Rich (BB code):
TextToColumns Destination:=Range("H2"),
VBA Code:
Sub formatsheet()
Dim lr As Long
lr = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
With Sheets("Sheet1")
    .Range("A2:A" & lr).Replace what:=".", replacement:=" "
    .Range("B2:B" & lr).Value = "I"
    .Range("G2:G" & lr).Value = "USA"
    .Range("F2:F" & lr).NumberFormat = "ddmmyyyy"
    .Range("F2:F" & lr).TextToColumns Destination:=Range("H2"), DataType:=xlDelimited, fieldinfo:=Array(1, 4), _
    trailingminusnumbers:=True
End With
End Sub
 

ChanL

New Member
Joined
Apr 8, 2021
Messages
17
Office Version
  1. 2019
Platform
  1. Windows
Maybe this way
Note I have change the destination here
Rich (BB code):
TextToColumns Destination:=Range("H2"),
VBA Code:
Sub formatsheet()
Dim lr As Long
lr = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
With Sheets("Sheet1")
    .Range("A2:A" & lr).Replace what:=".", replacement:=" "
    .Range("B2:B" & lr).Value = "I"
    .Range("G2:G" & lr).Value = "USA"
    .Range("F2:F" & lr).NumberFormat = "ddmmyyyy"
    .Range("F2:F" & lr).TextToColumns Destination:=Range("H2"), DataType:=xlDelimited, fieldinfo:=Array(1, 4), _
    trailingminusnumbers:=True
End With
End Sub
Thanks! I will try to work it out and see how.
 

ChanL

New Member
Joined
Apr 8, 2021
Messages
17
Office Version
  1. 2019
Platform
  1. Windows
Maybe this way
Note I have change the destination here
Rich (BB code):
TextToColumns Destination:=Range("H2"),
VBA Code:
Sub formatsheet()
Dim lr As Long
lr = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
With Sheets("Sheet1")
    .Range("A2:A" & lr).Replace what:=".", replacement:=" "
    .Range("B2:B" & lr).Value = "I"
    .Range("G2:G" & lr).Value = "USA"
    .Range("F2:F" & lr).NumberFormat = "ddmmyyyy"
    .Range("F2:F" & lr).TextToColumns Destination:=Range("H2"), DataType:=xlDelimited, fieldinfo:=Array(1, 4), _
    trailingminusnumbers:=True
End With
End Sub
The code runs perfectly until the this line was run :
VBA Code:
 .Range("F2:F" & lr).TextToColumns Destination:=Range("H2"), DataType:=xlDelimited, fieldinfo:=Array(1, 4), _
    trailingminusnumbers:=True

Just wondering, is it necessary to change destination? Because in my current code, I try to not change the destination, I use "destination:range("F2")"
The line was hitting error "438" - object doesn't support this property or method.
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,187
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Did you try it using Range("F2")....I simply thought that was an error >> :mad:
 

Watch MrExcel Video

Forum statistics

Threads
1,130,182
Messages
5,640,668
Members
417,160
Latest member
Timon82

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top