Quick macro help - paste values

[theta]

Hi

I need to prevent numbers stored at text. At present I use

oWS.UsedRange.Values = oWS.UsedRange.Values

This was working fine but now runs out of memory as dealing with a huge range

Can this be changed so that it does the .Values = .Values for each column in the Usedrange...scrolling until the operation has completed for all columns. (For each Column in UsedRange - or use a counter with UsedRange.Columns.Count ?)

This should then fix the memory problem

(or maybe rng as Range - for each rng ?)

Any help appreciated

Kind regards

 

[schielrn]

Maybe try:

For i = oWS.UsedRange.columns.count
oWS.UsedRange.resize(,1).offset(,i-1).Values = oWS.UsedRange.resize(,1).offset(,i-1).Values
next i

Note: This is untested and please try it on a copy as I cannot test it at the moment.

Hope that helps.

 

[Andrew Poulsom]

Did you try:

Dim Col As Range
For Each Col in oWS.UsedRange.Columns
    Col.Value = Col.Value
Next Col

 

[theta]

Hmmm. I'm really stuck and confused guys. One method works (but not on large data sets). And the other allows for the values to be stored, but then the autofilters fail in a macro that is called later on. These two codes should have the same effect ?

Works great, but not on huge UsedRange :

    ' ERROR 7 : Out of memory ----------------------------------------------------------
    ' Store numbers as text etc --------------------------------------------------------
    
'    Dim Col As Range
'    For Each Col In oWS.UsedRange.Columns
'        Col.Value = Col.Value
'    Next Col
    
    With oWS
       .UsedRange.Value = oWS.UsedRange.Value 'prevent numbers stored as text
       .Name = "XML Data"
       .Tab.Color = 49407
       .AutoFilterMode = False
       .Cells(1, nLastCol).AutoFilter
       .Range("A2").Select 'for Freeze Panes
    End With
    ActiveWindow.FreezePanes = True
    frmWait.lbxInfo.AddItem "Numbers stored as values"
    frmWait.Repaint

Version 2 - works on large data set, but must be something wrong with values as the autofilters fail in a later part of the code

    ' ERROR 7 : Out of memory ----------------------------------------------------------
    ' Store numbers as text etc --------------------------------------------------------
    
    Dim Col As Range
    For Each Col In oWS.UsedRange.Columns
        Col.Value = Col.Value
    Next Col
    
    With oWS
'       .UsedRange.Value = oWS.UsedRange.Value 'prevent numbers stored as text
       .Name = "XML Data"
       .Tab.Color = 49407
       .AutoFilterMode = False
       .Cells(1, nLastCol).AutoFilter
       .Range("A2").Select 'for Freeze Panes
    End With
    ActiveWindow.FreezePanes = True
    frmWait.lbxInfo.AddItem "Numbers stored as values"
    frmWait.Repaint

 

[theta]

Is the result of these two bits of code not exactly the same?

Kind regards

 

[Andrew Poulsom]

What error do you get in Version 2 and on which line?

 

[theta]

I get error 1004 - regarding autofilters and Ranges

Here is the sub that gets called (and fails).

Private Sub CopyFilteredData(owb As Workbook, oWS As Worksheet)
    Dim r As Long, sHPMN As String, nLastCol As Long, nMaxRows As Long, nFieldNo As Long
 
    With owb.Worksheets.Add(after:=owb.Worksheets(owb.Worksheets.Count))
        .Name = "Invoice>"
        .Tab.Color = 255
    End With
    With owb.Worksheets.Add(after:=owb.Worksheets(owb.Worksheets.Count))
        .Name = "HUB Agreements>"
        .Tab.Color = 255
    End With
    With owb.Worksheets.Add(after:=owb.Worksheets(owb.Worksheets.Count))
        .Name = "Bilateral>"
        .Tab.Color = 255
    End With
 
    nMaxRows = owb.Sheets("HPMN").PivotTables("HPMN Codes").RowRange.Count - 2 'skip Header / Footer
 
    If nMaxRows > 0 Then
'        frmWait.progProgBar.Min = 0
'        frmWait.progProgBar.Max = nMaxRows
'        frmWait.progProgBar.Value = 0
        frmWait.Repaint
        nFieldNo = FindFieldCol(oWS, "HPMN")
 
        With owb.Sheets("HPMN").PivotTables("HPMN Codes")
 
            For r = 1 To nMaxRows
                sHPMN = .RowFields(1).PivotItems(r)
                owb.Worksheets.Add(after:=owb.Worksheets(owb.Worksheets.Count)).Name = sHPMN
                With owb.Sheets("XML Data")
                    .AutoFilterMode = False
                    .Rows(1).AutoFilter
                    .Rows(1).AutoFilter field:=nFieldNo, Criteria1:=sHPMN
                End With
                owb.Sheets("XML Data").UsedRange.Copy owb.Sheets(sHPMN).Range("A1")
 
                nLastCol = Last("Col", owb.Sheets(sHPMN).UsedRange)
                With owb.Sheets(sHPMN)
                   .AutoFilterMode = False
                   .Cells(1, nLastCol).AutoFilter
                   .Range("A2").Select 'for Freeze Panes
                   .Range(Cells(1, 1), Cells(1, nLastCol)).Columns.EntireColumn.AutoFit
                End With
                ActiveWindow.FreezePanes = True
'                frmWait.progProgBar.Value = r
            Next r
 
            With owb.Sheets("XML Data")
                 .AutoFilterMode = False
                 .Range("A1").AutoFilter
            End With
            frmWait.lbxInfo.AddItem "HPMN Sheets added: " & r - 1 ' from for:next loop
        End With
    End If
 
End Sub

But if I used just the basic UsedRange.Value = UsedRange.Value then this sub runs fine. On large UsedRange it will not get this far though, without an error 7 out of memory (hence the column splitting) - the whole purpose is to remove numbers stored as text before getting to the above sub

Thanks for all help so far, i'm guessing it is something simple?

Kind regards

 

[Andrew Poulsom]

Which line causes the error and what is the exact text?

 

[theta]

No it fails when this sub is called.

Error is :

Error: 1004 AutoFilter methos of Range class failed

It is called using :

Call CopyFilteredData(owb, oWS)

 

[Andrew Poulsom]

Which line is highlighted when you get the error and what is the text of the error?