Column is overwritten

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
 
J

Jim Cone

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
 
W

webels

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
 
J

Jim Cone

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
 
W

webels

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Error with calling Format sub 7
Runtime error 1004 Application-defined or object defined error" on data sort 1
Permutations andText to column problem 6
Remove Identical words 0
Loop is slow trying array code 17
Code to sort rows getting hung up by merged cells 0
type mismatch error in macro in excel 0
Code execution is correct but generates Error :The file you aretrying to open is in a different form 3

Top