Column is overwritten
 

Hi

I have the following code to update a worksheet on a daily basis.

I would like to create a column with a row heading of Reviewed. in
column M.

This is fine but when I rerun the macro below new data overwrites this
column which will be left blank or have a Y for reviewed.

Code as follows

Sub TIPS()



ChDir "M:\Statdata"
Workbooks.OpenText Filename:="M:\Statdata\EDDTIPS.TXT",
Origin:=xlMSDOS, _
StartRow:=1, 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), Array(3, 1), Array(4, 1), Array(5, 1),
Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)),
TrailingMinusNumbers:=True, _
Local:=True '<- this decides date interpretation





Range("A1:M500").Select
Selection.Copy

Workbooks.Open Filename:= _
"G:\Microbiology\Registrars\TIPSICU.xls ", Origin:=xlWindows
Sheets("Main").Select

Range("A65536").End(xlUp).Offset(1, 0).Select

ActiveSheet.Paste

Cells.Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal

Columns("B:B").Select


Set Rng = ActiveSheet
R = 1
N = 1
With Rng
LastRow = .Range("B" & Rows.Count).End(xlUp).Row
Do While N <= LastRow
If R Mod 500 = 0 Then
Application.StatusBar = "Processing Row: " & Format(R,
"#,##0")
End If

V = .Range("B" & R).Value
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''
' Note that COUNTIF works oddly with a Variant that is equal to
'vbNullString.
' Rather than pass in the variant, you need to pass in vbNullString
'explicitly.
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''
If V = vbNullString Then
If Application.WorksheetFunction. _
CountIf(.Columns(1), vbNullString) 1 Then


.Rows(R).Delete
End If
Else
Next_V = .Range("B" & (R + 1)).Value
If V = Next_V Then
ThisDate = .Range("J" & R).Value


NextDate = .Range("J" & (R + 1)).Value
If ThisDate < NextDate Then
.Rows(R + 1).Delete
''? here

Else
.Rows(R).Delete
End If
Else
R = R + 1
End If
End If
N = N + 1
Loop
End With
Cells.Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending,
Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal

'header:xlYes refers to the fact that there is a header row


ActiveWorkbook.Save

Windows("TIPSICU.xls").Activate
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True

Windows("Macro.xls").Activate
Application.DisplayAlerts = False
Application.Quit



End Sub



Would anyone have any ideas on this one..

Many thanks
Eddie

Column is overwritten
 

Your explanation is difficult to understand...
In general what does the code do?
Did you write the code?

Do you want to create a column?
or
Do something to an existing column?
or
Not do something to an existing column?
or ?
--
Jim Cone
Portland, Oregon USA
http://tinyurl.com/ExtrasForXL

..
..
..

"webels"
wrote in message
...
Hi

I have the following code to update a worksheet on a daily basis.

I would like to create a column with a row heading of Reviewed. in
column M.

This is fine but when I rerun the macro below new data overwrites this
column which will be left blank or have a Y for reviewed.

Code as follows

Sub TIPS()



ChDir "M:\Statdata"
Workbooks.OpenText Filename:="M:\Statdata\EDDTIPS.TXT",
Origin:=xlMSDOS, _
StartRow:=1, 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), Array(3, 1), Array(4, 1), Array(5, 1),
Array(6, 1), Array(7, 1), Array(8, 1), _
Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)),
TrailingMinusNumbers:=True, _
Local:=True '<- this decides date interpretation





Range("A1:M500").Select
Selection.Copy

Workbooks.Open Filename:= _
"G:\Microbiology\Registrars\TIPSICU.xls ", Origin:=xlWindows
Sheets("Main").Select

Range("A65536").End(xlUp).Offset(1, 0).Select

ActiveSheet.Paste

Cells.Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal

Columns("B:B").Select


Set Rng = ActiveSheet
R = 1
N = 1
With Rng
LastRow = .Range("B" & Rows.Count).End(xlUp).Row
Do While N <= LastRow
If R Mod 500 = 0 Then
Application.StatusBar = "Processing Row: " & Format(R,
"#,##0")
End If

V = .Range("B" & R).Value
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''
' Note that COUNTIF works oddly with a Variant that is equal to
'vbNullString.
' Rather than pass in the variant, you need to pass in vbNullString
'explicitly.
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''
If V = vbNullString Then
If Application.WorksheetFunction. _
CountIf(.Columns(1), vbNullString) 1 Then


.Rows(R).Delete
End If
Else
Next_V = .Range("B" & (R + 1)).Value
If V = Next_V Then
ThisDate = .Range("J" & R).Value


NextDate = .Range("J" & (R + 1)).Value
If ThisDate < NextDate Then
.Rows(R + 1).Delete
''? here

Else
.Rows(R).Delete
End If
Else
R = R + 1
End If
End If
N = N + 1
Loop
End With
Cells.Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending,
Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal

'header:xlYes refers to the fact that there is a header row


ActiveWorkbook.Save

Windows("TIPSICU.xls").Activate
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True

Windows("Macro.xls").Activate
Application.DisplayAlerts = False
Application.Quit



End Sub



Would anyone have any ideas on this one..

Many thanks
Eddie

Column is overwritten
 

On Aug 17, 5:46*am, "Jim Cone" wrote:
Your explanation is difficult to understand...
In general what does the code do?
Did you write the code?

Do you want to create a column?
or
Do something to an existing column?
or
Not do something to an existing column?
or ?
--
Jim Cone
Portland, Oregon *USAhttp://tinyurl.com/ExtrasForXL

.
.
.

"webels"
wrote in ...
Hi

I have the following code to update a worksheet on a daily basis.

I would like to create a column with a row heading of Reviewed. in
column M.

This is fine but when I rerun the macro below new data overwrites this
column which will be left blank or have a Y for reviewed.

Code as follows

Sub TIPS()

ChDir "M:\Statdata"
* * Workbooks.OpenText Filename:="M:\Statdata\EDDTIPS.TXT",
Origin:=xlMSDOS, _
* * * * StartRow:=1, 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), Array(3, 1), Array(4, 1), Array(5, 1),
Array(6, 1), Array(7, 1), Array(8, 1), _
* * * * Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)),
TrailingMinusNumbers:=True, _
Local:=True * '<- this decides date interpretation

Range("A1:M500").Select
* * Selection.Copy

* * Workbooks.Open Filename:= _
* * * * "G:\Microbiology\Registrars\TIPSICU.xls ", Origin:=xlWindows
Sheets("Main").Select

Range("A65536").End(xlUp).Offset(1, 0).Select

ActiveSheet.Paste

* * Cells.Select
* * Selection.Sort Key1:=Range("B2"), Order1:=xlAscending,
Header:=xlGuess, _
* * * * OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
* * * * DataOption1:=xlSortNormal

* * Columns("B:B").Select

* *Set Rng = ActiveSheet
R = 1
N = 1
With Rng
* *LastRow = .Range("B" & Rows.Count).End(xlUp).Row
* *Do While N <= LastRow
* * * If R Mod 500 = 0 Then
* * * * *Application.StatusBar = "Processing Row: " & Format(R,
"#,##0")
* * * End If

* * * V = .Range("B" & R).Value
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''
' Note that COUNTIF works oddly with a Variant that is equal to
'vbNullString.
' Rather than pass in the variant, you need to pass in vbNullString
'explicitly.
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''
* * * If V = vbNullString Then
* * * * *If Application.WorksheetFunction. _
* * * * * * CountIf(.Columns(1), vbNullString) 1 Then

* * * * * * .Rows(R).Delete
* * * * *End If
* * * Else
* * * * *Next_V = .Range("B" & (R + 1)).Value
* * * * *If V = Next_V Then
* * * * * * ThisDate = .Range("J" & R).Value

* * * * * * NextDate = .Range("J" & (R + 1)).Value
* * * * * * If ThisDate < NextDate Then
* * * * * * * *.Rows(R + 1).Delete
* * * * * * * *''? here

* * * * * * Else
* * * * * * * *.Rows(R).Delete
* * * * * * End If
* * * * *Else
* * * * * * R = R + 1
* * * * *End If
* * * End If
* * * N = N + 1
* *Loop
End With
Cells.Select
* * Selection.Sort Key1:=Range("B2"), Order1:=xlAscending,
Header:=xlYes, _
* * * * OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
* * * * DataOption1:=xlSortNormal

'header:xlYes refers to the fact that there is a header row

ActiveWorkbook.Save

Windows("TIPSICU.xls").Activate
* * Application.DisplayAlerts = False
* * ActiveWorkbook.Close
* * Application.DisplayAlerts = True

* *Windows("Macro.xls").Activate
* * Application.DisplayAlerts = False
* * Application.Quit

End Sub

Would anyone have any ideas on this one..

Many thanks
Eddie

HI Jim
Thanks for your reply.

The code firstly pulls a test file from a folder and adds it to an
existing worksheet adding it to the next available space at the bottom
of the worksheet (this is the piece i wrote myself)

Now the bit i didn't write. The text file will have duplicate records
which I wish to eliminate. Based on a unique number on column B and an
extract date on Column J. I only keep unique records ie no duplicate
numbers in Col B and the oldest date (original extract date) on col J.

What I am hoping to get is a review Column on Col M which is tagged
with a Y when it has been seen by the reviewer. However when I set up
this column the Y's get blanked as new data is being added. I hope
this is clear and again thank you for looking at this for me.

Eddie

Column is overwritten
 

Maybe...

If ThisDate < NextDate Then
'Column M cell must be blank
If Len(.Cells(R + 1, 13)) = 0 Then .Rows(R + 1).Delete
''? here
Else
If Len(.Cells(R, 13)) = 0 Then .Rows(R).Delete
End If
--
Jim Cone
Portland, Oregon USA
http://tinyurl.com/XLCompanion

..
..
..

"webels"
wrote in message
...

HI Jim
Thanks for your reply.

The code firstly pulls a test file from a folder and adds it to an
existing worksheet adding it to the next available space at the bottom
of the worksheet (this is the piece i wrote myself)

Now the bit i didn't write. The text file will have duplicate records
which I wish to eliminate. Based on a unique number on column B and an
extract date on Column J. I only keep unique records ie no duplicate
numbers in Col B and the oldest date (original extract date) on col J.

What I am hoping to get is a review Column on Col M which is tagged
with a Y when it has been seen by the reviewer. However when I set up
this column the Y's get blanked as new data is being added. I hope
this is clear and again thank you for looking at this for me.

Eddie

Column is overwritten
 

On Aug 17, 3:46*pm, "Jim Cone" wrote:
Maybe...

* * * *If ThisDate < NextDate Then
* * * * *'Column M cell must be blank
* * * * * If Len(.Cells(R + 1, 13)) = 0 Then .Rows(R + 1).Delete
* * * * * ''? here
* * * *Else
* * * * * If Len(.Cells(R, 13)) = 0 Then .Rows(R).Delete
* * * *End If
--
Jim Cone
Portland, Oregon *USAhttp://tinyurl.com/XLCompanion

.
.
.

"webels"
wrote in ...

HI Jim
Thanks for your reply.

The code firstly pulls a test file from a folder and adds it to an
existing worksheet adding it to the next available space at the bottom
of the worksheet (this is the piece i wrote myself)

Now the bit i didn't write. The text file will have duplicate records
which I wish to eliminate. Based on a unique number on column B and an
extract date on Column J. I only keep unique records ie no duplicate
numbers in Col B and the oldest date (original extract date) on col J.

What I am hoping to get is a review Column on Col M which is tagged
with a Y when it has been seen by the reviewer. However when I set up
this column the Y's get blanked as new data is being added. I hope
this is clear and again thank you for looking at this for me.

Eddie

Thanks Jim for this idea-I have it working with slight alterations to
the code.

This was really helpful

Eddie