ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   pls reply Patrick Molly (https://www.excelbanter.com/excel-programming/337008-pls-reply-patrick-molly.html)

Tiya

pls reply Patrick Molly
 
Hi Patrick Molloy sorry for reply after 1 week.
Thanks for the reply it's working nicely but i have one problem it copys
same data again when i run the prog. 2nd time.

Is there any way it should not copy same data again if i run again.

code is here....

Option Explicit

Sub PopulateData()
' assume input file has a worksheet called Data
Dim ws As Worksheet
Set ws = Worksheets("data")
Dim rw As Long ' index for reading data
Dim targetrow As Long ' row for writing data
Dim wsTarget As Worksheet ' where data is to go
Dim Col As Long ' used for setting pmt or rct column

rw = 2 'assumes first row is heading

Do Until ws.Cells(rw, 1).Value = ""
If InStr(UCase(Cells(rw, 2).Value), "REC") 0 Then
Col = 4
Else
Col = 1
End If
Set wsTarget = safeSheet(Format$(ws.Cells(rw, 1).Value, "dd-mmmm"))
targetrow = wsTarget.Cells(56000, Col).End(xlUp).Row + 1

With wsTarget
With .Range(.Cells(targetrow, Col), .Cells(targetrow, Col + 2))
.Value = ws.Range(ws.Cells(rw, 2), ws.Cells(rw, 4)).Value
End With
End With
rw = rw + 1
Loop


End Sub
Private Function safeSheet(sSheetName As String) As Worksheet
On Error Resume Next
Set safeSheet = Worksheets(sSheetName)
If Err.Number < 0 Then
Err.Clear
Set safeSheet = ThisWorkbook.Worksheets.Add
safeSheet.Name = sSheetName
If Err.Number < 0 Then GoTo trap
End If
On Error GoTo 0
Exit Function
trap:
MsgBox Err.Description, , "Error Adding Worksheet:" & sSheetName
On Error GoTo 0
End Function


Thanks
Regards
Tiya Shah

Mangesh Yadav[_4_]

pls reply Patrick Molly
 
You mean to say:
Copies same data to the new position
or
copies new data to the same position...?

I think thet the code should copy to a new position, (the first
alternative).

Mangesh



"Tiya" wrote in message
...
Hi Patrick Molloy sorry for reply after 1 week.
Thanks for the reply it's working nicely but i have one problem it copys
same data again when i run the prog. 2nd time.

Is there any way it should not copy same data again if i run again.

code is here....

Option Explicit

Sub PopulateData()
' assume input file has a worksheet called Data
Dim ws As Worksheet
Set ws = Worksheets("data")
Dim rw As Long ' index for reading data
Dim targetrow As Long ' row for writing data
Dim wsTarget As Worksheet ' where data is to go
Dim Col As Long ' used for setting pmt or rct column

rw = 2 'assumes first row is heading

Do Until ws.Cells(rw, 1).Value = ""
If InStr(UCase(Cells(rw, 2).Value), "REC") 0 Then
Col = 4
Else
Col = 1
End If
Set wsTarget = safeSheet(Format$(ws.Cells(rw, 1).Value,

"dd-mmmm"))
targetrow = wsTarget.Cells(56000, Col).End(xlUp).Row + 1

With wsTarget
With .Range(.Cells(targetrow, Col), .Cells(targetrow, Col +

2))
.Value = ws.Range(ws.Cells(rw, 2), ws.Cells(rw, 4)).Value
End With
End With
rw = rw + 1
Loop


End Sub
Private Function safeSheet(sSheetName As String) As Worksheet
On Error Resume Next
Set safeSheet = Worksheets(sSheetName)
If Err.Number < 0 Then
Err.Clear
Set safeSheet = ThisWorkbook.Worksheets.Add
safeSheet.Name = sSheetName
If Err.Number < 0 Then GoTo trap
End If
On Error GoTo 0
Exit Function
trap:
MsgBox Err.Description, , "Error Adding Worksheet:" & sSheetName
On Error GoTo 0
End Function


Thanks
Regards
Tiya Shah




Tiya

pls reply Patrick Molly
 
Thanks for reply
I want if there is any change than in data tahn copies new data to the same
position other wise don't copy.
Regrads
Tiya

"Mangesh Yadav" wrote:

You mean to say:
Copies same data to the new position
or
copies new data to the same position...?

I think thet the code should copy to a new position, (the first
alternative).

Mangesh



"Tiya" wrote in message
...
Hi Patrick Molloy sorry for reply after 1 week.
Thanks for the reply it's working nicely but i have one problem it copys
same data again when i run the prog. 2nd time.

Is there any way it should not copy same data again if i run again.

code is here....

Option Explicit

Sub PopulateData()
' assume input file has a worksheet called Data
Dim ws As Worksheet
Set ws = Worksheets("data")
Dim rw As Long ' index for reading data
Dim targetrow As Long ' row for writing data
Dim wsTarget As Worksheet ' where data is to go
Dim Col As Long ' used for setting pmt or rct column

rw = 2 'assumes first row is heading

Do Until ws.Cells(rw, 1).Value = ""
If InStr(UCase(Cells(rw, 2).Value), "REC") 0 Then
Col = 4
Else
Col = 1
End If
Set wsTarget = safeSheet(Format$(ws.Cells(rw, 1).Value,

"dd-mmmm"))
targetrow = wsTarget.Cells(56000, Col).End(xlUp).Row + 1

With wsTarget
With .Range(.Cells(targetrow, Col), .Cells(targetrow, Col +

2))
.Value = ws.Range(ws.Cells(rw, 2), ws.Cells(rw, 4)).Value
End With
End With
rw = rw + 1
Loop


End Sub
Private Function safeSheet(sSheetName As String) As Worksheet
On Error Resume Next
Set safeSheet = Worksheets(sSheetName)
If Err.Number < 0 Then
Err.Clear
Set safeSheet = ThisWorkbook.Worksheets.Add
safeSheet.Name = sSheetName
If Err.Number < 0 Then GoTo trap
End If
On Error GoTo 0
Exit Function
trap:
MsgBox Err.Description, , "Error Adding Worksheet:" & sSheetName
On Error GoTo 0
End Function


Thanks
Regards
Tiya Shah





Mangesh Yadav[_4_]

pls reply Patrick Molly
 
When and how do you run the macro. Is it a manual action (by pressing a
button somewhere) or are you calling it in another macro. Also on what data
change you want it to run. You could call this macro in the worksheet_change
event.

Mangesh



"Tiya" wrote in message
...
Thanks for reply
I want if there is any change than in data tahn copies new data to the

same
position other wise don't copy.
Regrads
Tiya

"Mangesh Yadav" wrote:

You mean to say:
Copies same data to the new position
or
copies new data to the same position...?

I think thet the code should copy to a new position, (the first
alternative).

Mangesh



"Tiya" wrote in message
...
Hi Patrick Molloy sorry for reply after 1 week.
Thanks for the reply it's working nicely but i have one problem it

copys
same data again when i run the prog. 2nd time.

Is there any way it should not copy same data again if i run again.

code is here....

Option Explicit

Sub PopulateData()
' assume input file has a worksheet called Data
Dim ws As Worksheet
Set ws = Worksheets("data")
Dim rw As Long ' index for reading data
Dim targetrow As Long ' row for writing data
Dim wsTarget As Worksheet ' where data is to go
Dim Col As Long ' used for setting pmt or rct column

rw = 2 'assumes first row is heading

Do Until ws.Cells(rw, 1).Value = ""
If InStr(UCase(Cells(rw, 2).Value), "REC") 0 Then
Col = 4
Else
Col = 1
End If
Set wsTarget = safeSheet(Format$(ws.Cells(rw, 1).Value,

"dd-mmmm"))
targetrow = wsTarget.Cells(56000, Col).End(xlUp).Row + 1

With wsTarget
With .Range(.Cells(targetrow, Col), .Cells(targetrow, Col

+
2))
.Value = ws.Range(ws.Cells(rw, 2), ws.Cells(rw,

4)).Value
End With
End With
rw = rw + 1
Loop


End Sub
Private Function safeSheet(sSheetName As String) As Worksheet
On Error Resume Next
Set safeSheet = Worksheets(sSheetName)
If Err.Number < 0 Then
Err.Clear
Set safeSheet = ThisWorkbook.Worksheets.Add
safeSheet.Name = sSheetName
If Err.Number < 0 Then GoTo trap
End If
On Error GoTo 0
Exit Function
trap:
MsgBox Err.Description, , "Error Adding Worksheet:" & sSheetName
On Error GoTo 0
End Function


Thanks
Regards
Tiya Shah







Tiya

pls reply Patrick Molly
 
I just Run prog. It is manual action. I want if same data is there in
worksheet it should not copy again.
E.g.
if i have 10 data for date 1-7-05 than if i entry 11th data it should entry
new data in worksheet and not all data again.
Tiya
"Mangesh Yadav" wrote:

When and how do you run the macro. Is it a manual action (by pressing a
button somewhere) or are you calling it in another macro. Also on what data
change you want it to run. You could call this macro in the worksheet_change
event.

Mangesh



"Tiya" wrote in message
...
Thanks for reply
I want if there is any change than in data tahn copies new data to the

same
position other wise don't copy.
Regrads
Tiya

"Mangesh Yadav" wrote:

You mean to say:
Copies same data to the new position
or
copies new data to the same position...?

I think thet the code should copy to a new position, (the first
alternative).

Mangesh



"Tiya" wrote in message
...
Hi Patrick Molloy sorry for reply after 1 week.
Thanks for the reply it's working nicely but i have one problem it

copys
same data again when i run the prog. 2nd time.

Is there any way it should not copy same data again if i run again.

code is here....

Option Explicit

Sub PopulateData()
' assume input file has a worksheet called Data
Dim ws As Worksheet
Set ws = Worksheets("data")
Dim rw As Long ' index for reading data
Dim targetrow As Long ' row for writing data
Dim wsTarget As Worksheet ' where data is to go
Dim Col As Long ' used for setting pmt or rct column

rw = 2 'assumes first row is heading

Do Until ws.Cells(rw, 1).Value = ""
If InStr(UCase(Cells(rw, 2).Value), "REC") 0 Then
Col = 4
Else
Col = 1
End If
Set wsTarget = safeSheet(Format$(ws.Cells(rw, 1).Value,
"dd-mmmm"))
targetrow = wsTarget.Cells(56000, Col).End(xlUp).Row + 1

With wsTarget
With .Range(.Cells(targetrow, Col), .Cells(targetrow, Col

+
2))
.Value = ws.Range(ws.Cells(rw, 2), ws.Cells(rw,

4)).Value
End With
End With
rw = rw + 1
Loop


End Sub
Private Function safeSheet(sSheetName As String) As Worksheet
On Error Resume Next
Set safeSheet = Worksheets(sSheetName)
If Err.Number < 0 Then
Err.Clear
Set safeSheet = ThisWorkbook.Worksheets.Add
safeSheet.Name = sSheetName
If Err.Number < 0 Then GoTo trap
End If
On Error GoTo 0
Exit Function
trap:
MsgBox Err.Description, , "Error Adding Worksheet:" & sSheetName
On Error GoTo 0
End Function


Thanks
Regards
Tiya Shah







Mangesh Yadav[_4_]

pls reply Patrick Molly
 
Then you probably need some code like this:

Private Sub Worksheet_Change(ByVal Target As Range)

' this module goes in sheet1 from where data is copied to sheet2
Set mySht = Worksheets("Sheet2") ' this is the sheet where data is
copied to

myRow = mySht.Cells(65536, Target.Column).End(xlUp).Row + 1

mySht.Cells(myRow, Target.Column) = Cells(Target.Row, Target.Column)

End Sub



Sheet 1 is where you enter new data, and sheet2 is where your data gets
copied.

Mangesh




"Tiya" wrote in message
...
I just Run prog. It is manual action. I want if same data is there in
worksheet it should not copy again.
E.g.
if i have 10 data for date 1-7-05 than if i entry 11th data it should

entry
new data in worksheet and not all data again.
Tiya
"Mangesh Yadav" wrote:

When and how do you run the macro. Is it a manual action (by pressing a
button somewhere) or are you calling it in another macro. Also on what

data
change you want it to run. You could call this macro in the

worksheet_change
event.

Mangesh



"Tiya" wrote in message
...
Thanks for reply
I want if there is any change than in data tahn copies new data to the

same
position other wise don't copy.
Regrads
Tiya

"Mangesh Yadav" wrote:

You mean to say:
Copies same data to the new position
or
copies new data to the same position...?

I think thet the code should copy to a new position, (the first
alternative).

Mangesh



"Tiya" wrote in message
...
Hi Patrick Molloy sorry for reply after 1 week.
Thanks for the reply it's working nicely but i have one problem it

copys
same data again when i run the prog. 2nd time.

Is there any way it should not copy same data again if i run

again.

code is here....

Option Explicit

Sub PopulateData()
' assume input file has a worksheet called Data
Dim ws As Worksheet
Set ws = Worksheets("data")
Dim rw As Long ' index for reading data
Dim targetrow As Long ' row for writing data
Dim wsTarget As Worksheet ' where data is to go
Dim Col As Long ' used for setting pmt or rct column

rw = 2 'assumes first row is heading

Do Until ws.Cells(rw, 1).Value = ""
If InStr(UCase(Cells(rw, 2).Value), "REC") 0 Then
Col = 4
Else
Col = 1
End If
Set wsTarget = safeSheet(Format$(ws.Cells(rw, 1).Value,
"dd-mmmm"))
targetrow = wsTarget.Cells(56000, Col).End(xlUp).Row + 1

With wsTarget
With .Range(.Cells(targetrow, Col), .Cells(targetrow,

Col
+
2))
.Value = ws.Range(ws.Cells(rw, 2), ws.Cells(rw,

4)).Value
End With
End With
rw = rw + 1
Loop


End Sub
Private Function safeSheet(sSheetName As String) As Worksheet
On Error Resume Next
Set safeSheet = Worksheets(sSheetName)
If Err.Number < 0 Then
Err.Clear
Set safeSheet = ThisWorkbook.Worksheets.Add
safeSheet.Name = sSheetName
If Err.Number < 0 Then GoTo trap
End If
On Error GoTo 0
Exit Function
trap:
MsgBox Err.Description, , "Error Adding Worksheet:" &

sSheetName
On Error GoTo 0
End Function


Thanks
Regards
Tiya Shah










All times are GMT +1. The time now is 10:06 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com