help with select and selection issues

espenskeie

Well-known Member
Joined
Mar 30, 2009
Messages
636
Office Version
  1. 2016
Platform
  1. Windows
Hi

I have not control over how to remove the .select and selection stuff, often my code ends up not working at all if I try to do some changes.

Could someone tell me how this code could be cleaner?
Code:
Dim ws As Worksheet, ws2 As Worksheet
    
    Set ws = Worksheets("1HourHL")
    Set ws2 = Worksheets("1HourDATA")
    
    ws.Activate
    Columns("A1:A65536").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="_", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
        
    Columns("B1:B65536").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :=".", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
        
    Columns("C1:C65536").Select
    Selection.ClearContents

Regards
Espen
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Espen

You would clean it up by removing the Select/Selection, but if you can't do that then I don't know how else the code can be cleaned up.

If you did remove them the code would look something like this.
Code:
Dim ws As Worksheet, ws2 As Worksheet
    Set ws = Worksheets("1HourHL")
    Set ws2 = Worksheets("1HourDATA")
    ws.Activate
    With ws
        .Columns(1).TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, _
                                  TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                                  Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
                                                                                             :="_", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
        .Columns(2).TextToColumns Destination:=.Range("B1"), DataType:=xlDelimited, _
                                  TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                                  Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
                                                                                             :=".", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
        .Columns(3).ClearContents
    End With
 
Upvote 0
Thanks Norie, I will try that and see how it works. What about the select here, when its two workbooks wb1 and wb2:

Code:
Range("A" & found1.Row & ":G" & found1.Row).Copy
                wb2.Activate
                sh3.Select
                Range("C" & lrcpy).Select
                ActiveSheet.Paste

Is this correct?

Code:
Range("A" & found1.Row & ":G" & found1.Row).Copy wb2.sh3.Range("C" & lrcpy).Paste

Regards
Espen
 
Upvote 0
Espen

No not quite.

Which worksheet/workbook are you copying from and which are you copying to?

Also where have you defined sh3 and wb2?

Is sh3 a reference to a worksheet in wb2?
 
Upvote 0
Norie, sorry I did not include the rest of the codes, here they are:

Code:
''' Dynamisk navngivelse av folder og fil for å hente EOD dataene
            which_file = (Sheets("1HourHL").Range("A" & t) & "_" & Sheets("1HourHL").Range("B" & t))

''' Korrekt adresse for å finne tekstfila som inneholder alle data som skal kopieres
            which_string = Desktop & "Intraday\Textfiles\EOD\" & which_file & ".txt"

''' Åpner tekstfila og utfører "text to columns"
                Workbooks.OpenText Filename:= _
                    which_string _
                    , Origin:=xlMSDOS, startrow:=1, DataType:=xlDelimited, TextQualifier:= _
                    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
                    Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
                    Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1)), _
                    TrailingMinusNumbers:=True
                           
                Set wb1 = Workbooks(which_file) 'Edit workbook name
                Set wb2 = Workbooks("IntraUser2003") 'Edit workbook name
                Set sh1 = wb1.Sheets(which_file) 'Edit sheet name
                Set sh2 = wb2.Sheets("1HourHL")
                Set sh3 = wb2.Sheets("1HourDATA")
                Set ticker = Workbooks("IntraUser2003").Sheets("1HourHL").Range("W2")
    
''' Ved å finne rad plasseringen på tickeren kan man beregne hvor koden må gå for å få
''' hentet ut EOD-data

            lrEOD = Worksheets(which_file).Cells(Rows.count, 1).End(xlUp).Row
            Set found1 = Sheets(which_file).Columns("A").Find(What:=ticker.Value, LookIn:=xlValues, LookAt:=xlWhole)

            If found1 Is Nothing Then
''' En boks med feilmedling kommer opp dersom "last date" ikke eksisterer
                MsgBox "There is no record found on this date" + vbCrLf + "for this stock."
            Else
                Range("A" & found1.Row & ":G" & found1.Row).Copy
                wb2.Activate
                sh3.Select
                Range("C" & lrcpy).Select
                ActiveSheet.Paste
 
Upvote 0
Try this, but notice there's a reference missing.
Code:
''' Dynamisk navngivelse av folder og fil for å hente EOD dataene
    which_file = (Sheets("1HourHL").Range("A" & t) & "_" & Sheets("1HourHL").Range("B" & t))
    ''' Korrekt adresse for å finne tekstfila som inneholder alle data som skal kopieres
    which_string = Desktop & "Intraday\Textfiles\EOD\" & which_file & ".txt"
    ''' Åpner tekstfila og utfører "text to columns"
    Workbooks.OpenText Filename:= _
                       which_string _
                       , Origin:=xlMSDOS, startrow:=1, DataType:=xlDelimited, TextQualifier:= _
                       xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
                       Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
                                                                                 Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1)), _
                                                                                 TrailingMinusNumbers:=True
    Set wb1 = Workbooks(which_file)    'Edit workbook name
    Set wb2 = Workbooks("IntraUser2003")    'Edit workbook name
    Set sh1 = wb1.Sheets(which_file)    'Edit sheet name
    Set Sh2 = wb2.Sheets("1HourHL")
    Set sh3 = wb2.Sheets("1HourDATA")
    Set ticker = Sh2.Range("W2")
    ''' Ved å finne rad plasseringen på tickeren kan man beregne hvor koden må gå for å få
    ''' hentet ut EOD-data
    lrEOD = sh1.Cells(Rows.Count, 1).End(xlUp).Row
    Set found1 = sh1.Columns("A").Find(What:=ticker.Value, LookIn:=xlValues, LookAt:=xlWhole)
    If found1 Is Nothing Then
        ''' En boks med feilmedling kommer opp dersom "last date" ikke eksisterer
        MsgBox "There is no record found on this date" + vbCrLf + "for this stock."
    Else
        ''' the following line has a missing worksheet reference for the range getting copied
        Range("A" & found1.Row & ":G" & found1.Row).Copy Sh2.Range("C" & lrpcy)
    End If
 
Upvote 0
Thanks Norie, it looks much better. I will test it as soon as I get a hold of my Error issue :) And will return with status then.
 
Upvote 0

Forum statistics

Threads
1,211,868
Messages
6,104,458
Members
447,910
Latest member
abrook1308

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
Back
Top