help with select and selection issues

[espenskeie]

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?

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

 

[Norie]

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.

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

 

[espenskeie]

Thanks Norie, I will try that and see how it works. What about the select here, when its two workbooks wb1 and wb2:

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

Is this correct?

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

Regards
Espen

 

[Norie]

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?

 

[espenskeie]

Norie, sorry I did not include the rest of the codes, here they are:

''' 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

 

[Norie]

Try this, but notice there's a reference missing.

''' 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

 

[espenskeie]

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.