Inserting cells to the left based on cell value

**Judge Dredd** · 02-24-2011, 02:57 PM

Hi All,
well my post from yesterday was answered quickly (THANKS Pike) but I noticed a quirk in my data sets that necessitates some additional coding.
I have multiple test results (as CSV text files) in a directory that I can now import at the push of a button, but I noticed that some of the test results have an additional 16 columns of data in (they have 4 channels tested not just 2). Upshot is that during the test import, I need to see if the value of the field (always column "AP") reads as "Line3-DCVoltage3", ( this unit has the extra lines being tested), if this is true then I need to insert 16 blank cells (to the right of course) before the next cell is imported (would now be "BF")

Or to put it another way, if "AP" = "Line3-DCVoltage3", then skip to column "BF" and continue with the text import, else do nothing .

Code currently reads as follows:

 Dim strPath As String
 Dim strFile As String
 
 
 strPath = "C:\ont\"
 strFile = Dir(strPath & "*.txt")

 Do While strFile <> ""
 
 With ActiveWorkbook.ActiveSheet
 With .QueryTables.Add(Connection:="TEXT;" & strPath & strFile, _
  Destination:=.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0))
 .Parent.Name = Replace(strFile, ".txt", "")
 .TextFileParseType = xlDelimited
 .TextFileTextQualifier = xlTextQualifierDoubleQuote
 .TextFileConsecutiveDelimiter = False
 .TextFileTabDelimiter = False
 .TextFileSemicolonDelimiter = False
 .TextFileCommaDelimiter = True
 .TextFileSpaceDelimiter = False
 .TextFileColumnDataTypes = Array(1)
 .TextFileTrailingMinusNumbers = True
 .Refresh BackgroundQuery:=False
 
 End With
 End With
 
 strFile = Dir

 Loop

Thanks for your help

**pike** · 02-25-2011, 07:29 AM

Hi Judge Dredd,
The code you are using just imports. It doesnt read the txt line to determine any values.

**Judge Dredd** · 02-25-2011, 10:58 AM

Thanks Pike,
I understand that now. So would the correct way to be to insert a If / then statement inside the loop to check the value as it is being imported (something like:-)

If ActiveCell.Value <> "Line3-DCVoltage3" Then
 
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove (repeat 16 times)
Else
EndIf

or let the import finish, then loop through the data, look in column AP for the value, and execute a shift on the criteria being met. I would think the code above would also be something like what I need but it be preceeded by commands to find the data. Something like:

Columns("AP:AP").Select
    Selection.Find(What:="MocaTxBitRate", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
        
    If ActiveCell.Value = ("MocaTxBitRate") Then
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Else
    Selection.Find(What:="MocaTxBitRate", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
End If

I tried this and it does find the text and inserts cells, but it inserts columns regardless of the cell value, so I assume that my use of the "If ActiveCell.Value...." is incorrect.
Thanks

**pike** · 02-25-2011, 06:54 PM

Hi
You would need to use a different import code to read each cell value in csv and
then you could use something like if the line value <> Line3-DCVoltage3

would be better to cut and paste value the shift the columns

can you post the different csv files

**Judge Dredd** · 02-28-2011, 10:24 AM

Sure can, attached are a couple of the csv files, one with 2 test channels and one with 4.
When I run the code, the first part brings in the text just fine.

Dim strPath As String
Dim strFile As String
 
 strPath = "C:\ont\"
 strFile = Dir(strPath & "*.txt")

 Do While strFile <> ""
 
 With ActiveWorkbook.ActiveSheet
 With .QueryTables.Add(Connection:="TEXT;" & strPath & strFile, _
  Destination:=.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0))
 .Parent.Name = Replace(strFile, ".txt", "")
 .TextFileParseType = xlDelimited
 .TextFileTextQualifier = xlTextQualifierDoubleQuote
 .TextFileConsecutiveDelimiter = False
 .TextFileTabDelimiter = False
 .TextFileSemicolonDelimiter = False
 .TextFileCommaDelimiter = True
 .TextFileSpaceDelimiter = False
 .TextFileColumnDataTypes = Array(1)
 .TextFileTrailingMinusNumbers = True
 .Refresh BackgroundQuery:=False
 
 End With
 End With
 
 strFile = Dir

 Loop

The second part of the code is meant to search through and find the text "MocaTxBitRate" in column AP, and if true, insert 16 blank columns. Unfortunately it seems to insert 16 columns regardless of the conditions. So I know that the insert part works, the only issue seems to be not inserting if the condition is false. There is also probably a better way than just repeating the command 16 times, this seems a bit of a brute force method.

Columns("AP:AP").Select
    Selection.Find(What:="MocaTxBitRate", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
        
    If ActiveCell.Value = ("MocaTxBitRate") Then
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Else
    Selection.Find(What:="MocaTxBitRate", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
End If

Thanks again, you have been a huge help. Excelforum is indeed the only place to go for help.

**pike** · 03-11-2011, 04:39 AM

Hi Judge Dredd,
Apologies for the delay as ive been away for a week or so,

Dim FoundOne As Range, LookInR As Range, fAddress As String
   
Set LookInR = ActiveSheet.Range("AP1", Cells(Rows.Count, 42).End(xlUp))
With LookInR
    
        Set FoundOne = .Find(What:="MocaTxBitRate", LookAt:=xlPart)
        If Not FoundOne Is Nothing Then
            fAddress = FoundOne.Address

            Do
               Range("AP" & FoundOne.Row & ":BI" & FoundOne.Row).Cut Destination:=Range("Bf" & FoundOne.Row)

                Set FoundOne = .FindNext
            Loop While Not FoundOne Is Nothing
        End If
   
End With
Set LookInR = Nothing