PDA

View Full Version : Can you help fix this macro?



JonnyEnglish
01-29-2016, 07:33 AM
Hi, I can’t find what is wrong with this macro, can you guys help? I’ve attached a couple of files to hopefully demonstrate the problem and to give you a look at what I’m after.

Any help would be appreciated

SamT
01-29-2016, 07:41 AM
OP code
Sub OpenTextFileAndSave()
Dim lngR As Long
Dim strName As String

strName = Application.GetOpenFilename("txt files,*.txt")
If strName = "False" Then Exit Sub

Workbooks.OpenText Filename:= _
strName, Origin:=1257, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=True, OtherChar:=":", FieldInfo:=Array(Array(1, 1 _
), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True
With ActiveSheet.UsedRange
.Range("B:B").SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=TRIM(R[1]C)"
.Range("C:C").SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=TRIM(SUBSTITUTE(LEFT(R[1]C,FIND("")"",R[1]C)-1),""("",""""))"
With .Range("D:D").SpecialCells(xlCellTypeBlanks)
.FormulaR1C1 = "=VALUE(TRIM(MID(R[1]C[-1],FIND("")"",R[1]C[-1])+1,LEN(R[1]C[-1]))))"
.Offset(0, 1).FormulaR1C1 = "=TRIM(R[1]C[-1])"
End With
.Range("B:E").Value = .Range("B:E").Value
End With
For lngR = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -2
Cells(lngR, 1).EntireRow.Delete
Next lngR
Range("A:E").EntireColumn.AutoFit
ActiveWorkbook.SaveAs Replace(strName, ".txt", ".xlsx"), FileFormat:=51
End Sub

Sample of OP data source
"Chrispy1990___________X:"
Optimized Deck: 8 units: (0.113529% stall) 69.8303: Halcyon, Stonewall Garrison, Ambush Neutralizer, Blast Twin, Spur Buggy, Station Fortifier, Hawkler Gun, Top Hawkler, Sky Flyer
"Breezus_______________X:"
Optimized Deck: 8 units: (0.0208824% stall) 86.0953: Silus the Corrupt, Zorbo the Master, Extreme Barrager, Tetrapede Comber, Orion Survivor, Atomic Wardriver #4

Sample Desired Output


Chrispy1990___________X
8 units
0.113529% stall
69.8303
Halcyon, Stonewall Garrison, Etc


Breezus_______________X
8 units
0.0208824% stall

86.0953
Silus the Corrupt, Etc

JonnyEnglish
01-29-2016, 08:19 AM
Hi sorry bud. The macro is meant to import and sort data from the source file into excel so it looks like the data in the “desired output” workbook but at the moment it’s replacing people’s names with “Optimized Deck” as illustrated in the “current output” workbook

SamT
01-29-2016, 11:58 AM
at the moment it’s replacing people’s names with “Optimized Deck”
You're probably deleting the wrong Rows.

See what you get when you comment out this line

For lngR = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -2
'Cells(lngR, 1).EntireRow.Delete
Next lngR

JonnyEnglish
01-29-2016, 03:29 PM
End With

'For lngR = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -2
'Cells(lngR, 1).EntireRow.Delete
'Next lngR
'Range("A:E").EntireColumn.AutoFit

For i = 2 To 100
Cells(i, 1).Select
ActiveCell.EntireRow.Delete
Next i
Columns("A:E").Select
Columns("A:E").EntireColumn.AutoFit
ActiveWorkbook.SaveAs Replace(strName, ".txt", ".xlsx"), FileFormat:=51
End Sub

Ok so I replaced the txt in red with the code below it and it seems to work. Thanks for point me in the right direction.

SamT
01-29-2016, 08:43 PM
Try this

i = Cells(Rows.Count, "A").End(xlUp).Row
If i Mod 2 = 1 then i = i + 1 'If i is odd then add 1

For i = i To To 2 Step -2 'Yes, you can reuse variables like this
Rows(i).Delete
Next i