Column is overwritten

  • Thread starter Thread starter webels
  • Start date Start date
W

webels

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
 
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" <[email protected]>
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
 
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" <[email protected]>
wrote in messageHi

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
Click to expand...

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
 
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" <[email protected]>
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
 
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" <[email protected]>
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
Click to expand...

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

This was really helpful

Eddie
 
Back
Top