Insert Into where Table Size Is Unknown

dancole42

Registered User.
Local time
Yesterday, 19:03
Joined
Dec 28, 2012
Messages
21
I have an extremely sloppy table I need to clean up.

The first two fields are the origin file and the origin worksheet of an Excel import.

The next fields are often, but not always blank, fields that I need to consolidate into a SINGLE field. In other words...

OriginFile
OriginWorksheet
F1
F2
F3
F4
F5
F????

Becomes:
ConvertFile
ConvertWorkSheet
ConvertF

Code:
    Dim strUpdate, strField As String
    Dim i As Long
    
    With CurrentDb.OpenRecordset("Select * From Raw2", dbOpenSnapshot)
        .MoveFirst
        Do While Not .EOF
            For i = 2 To .Fields.Count - 1
                If Nz(.Fields(i).Value, "") <> "" Then
                strField = .Fields(i).Name
                    strUpdate = "Insert Into Raw2Convert (ConvertFile, ConvertWorksheet, ConvertF) " _
                           & "SELECT OriginFile, OriginWorksheet, " & strField & " FROM Raw2 WHERE " & strField & " is not null;"
                    CurrentDb.Execute strUpdate, dbFailOnError
                End If
            Next
            .MoveNext
        Loop
    End With

My problem is that the output is becoming way larger than it should be.

Any ideas?

Thanks!
 
Try this:
Code:
Private Sub TidyUpFields()
On Error GoTo Err_Tidy

    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("Select * From Raw2", dbOpenSnapshot)
    
    If rs.RecordCount = 0 Then
        Exit Sub
    End If
    
    rs.MoveFirst
    
    Dim idx As Long
    Dim strFieldName As String
    Dim strUpdateCmd As String

    With rs
        Do While Not .EOF
            For idx = 2 To .Fields.Count - 1
                If Nz(.Fields(idx).Value, "") <> "" Then
                    strFieldName = .Fields(idx).Name
                    strUpdateCmd = "INSERT INTO Raw2Convert (ConvertFile, ConvertWorksheet, ConvertF) " _
                           & "VALUES ('" & .Fields(0).Value & "', '" & .Fields(1).Value & "', '" & .Fields(idx).Value & "');"
                           
                    CurrentDb.Execute strUpdateCmd, dbFailOnError
                End If
            Next idx
            
            .MoveNext
        Loop
    End With
        
    rs.Close
    
    MsgBox "Clearance completed successfully!", vbInformation

Exit_Tidy:
    Set rs = Nothing
    Exit Sub
    
Err_Tidy:
    MsgBox Err.Description
    Resume Exit_Tidy
    
End Sub
 
Perfect. Thank you!!!
 

Users who are viewing this thread

Back
Top Bottom