ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Need some help with this code: (https://www.excelbanter.com/excel-programming/405216-need-some-help-code.html)

Koen

Need some help with this code:
 
Hi,

I'm not good in programming in VBA, but I managed to put together the
following (thanks to Susan, Ron, JLGwhiz and Dave Miller):
The purpose of this is to copy a sheet to a backupfile, so I can gather lots
of data to be put in an excelchart.
In the inputsheet there's lots of data that's the same, hence the
"-character. In the code there's a part that replaces these "-characters by
the value above.

(see topic:
http://www.microsoft.com/communities...2-35d9d717cd39 )

Yet I can't find the way to do this without making a selection.
Also, the original sheet may not by altered (which is the case now).
My third problem is the static range. I'd like to have a range that is
dynamic, cause the data in the input sheet is not always the same amount of
rows.
And I don't want any blanks in my backupfile.

Also, if you can do something with lesser code or if you can simplify the
code, it would be of much importance to me.

Thanks in advance, and here is the code:
-----

Sub Copy_To_Another_Workbook()
Dim SourceRange As Range
Dim DestRange As Range
Dim DestWB As Workbook
Dim DestSh As Worksheet
Dim Lr As Long

'change the apostrophe to previous value
For Each SourceRange In Selection
If SourceRange.Value Like Chr(34) Then
SourceRange.Value = SourceRange.Offset(-1, 0).Value
End If
Next
With Application
.ScreenUpdating = False
.EnableEvents = False
End With

'Change the file name (2*) and the path/file name to your file
If bIsBookOpen_RB("Backup.xls") Then
Set DestWB = Workbooks("Backup.xls")
Else
Set DestWB = Workbooks.Open("o:\data\Backup.xls")
End If

'Change the Source Sheet and range
Set SourceRange = ThisWorkbook.Sheets("Sheet1").Range("A11:k50")
'Change the sheet name of the database workbook
Set DestSh = DestWB.Worksheets("Sheet1")


Lr = LastRow(DestSh)
Set DestRange = DestSh.Range("A" & Lr + 1)

'We make DestRange the same size as SourceRange and use the Value
'property to give DestRange the same values
With SourceRange
Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count)
End With
DestRange.Value = SourceRange.Value

DestWB.Close savechanges:=True

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function


Function bIsBookOpen_RB(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen_RB = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

-----

Ed from AZ

Need some help with this code:
 
Yet I can't find the way to do this without making a selection.
My third problem is the static range. I'd like to have a range that is
dynamic, cause the data in the input sheet is not always the same amount of
rows.


Could you use your LastRow And LastCol functions to get the dimensions
of your input range?

Dim InputSh As Worksheet
Dim InputRng As Range
Dim x As Long, y As Long
Set InputSh = ActiveSheet
x = LastRow(InputSh)
y = LastCol(InputSh)
Set InputRng = InputSh.Range(Cells(1,1),Cells(x,y))

'change the apostrophe to previous value
For Each SourceRange In InputRng
etc.

As far as altering the source worksheet, why not copy the source rnage
into the backup file and THEN do all the manipulations? Or can you
simply close the source book without saving changes?

Ed

On Jan 29, 6:06*am, Koen wrote:
Hi,

I'm not good in programming in VBA, but I managed to put together the
following (thanks to Susan, Ron, JLGwhiz and Dave Miller):
The purpose of this is to copy a sheet to a backupfile, so I can gather lots
of data to be put in an excelchart.
In the inputsheet there's lots of data that's the same, hence the
"-character. In the code there's a part that replaces these "-characters by
the value above.

(see topic:http://www.microsoft.com/communities...efault.aspx?&q...)

Yet I can't find the way to do this without making a selection.
Also, the original sheet may not by altered (which is the case now).
My third problem is the static range. I'd like to have a range that is
dynamic, cause the data in the input sheet is not always the same amount of
rows.
And I don't want any blanks in my backupfile.

Also, if you can do something with lesser code or if you can simplify the
code, it would be of much importance to me.

Thanks in advance, and here is the code:
-----

Sub Copy_To_Another_Workbook()
* * Dim SourceRange As Range
* * Dim DestRange As Range
* * Dim DestWB As Workbook
* * Dim DestSh As Worksheet
* * Dim Lr As Long

* * 'change the apostrophe to previous value
* * For Each SourceRange In Selection
* * * * If SourceRange.Value Like Chr(34) Then
* * * * * * SourceRange.Value = SourceRange.Offset(-1, 0).Value
* * * * End If
* * Next
* * With Application
* * * * .ScreenUpdating = False
* * * * .EnableEvents = False
* * End With

* * 'Change the file name (2*) and the path/file name to your file
* * If bIsBookOpen_RB("Backup.xls") Then
* * * * Set DestWB = Workbooks("Backup.xls")
* * Else
* * * * Set DestWB = Workbooks.Open("o:\data\Backup.xls")
* * End If

* * 'Change the Source Sheet and range
* * Set SourceRange = ThisWorkbook.Sheets("Sheet1").Range("A11:k50")
* * 'Change the sheet name of the database workbook
* * Set DestSh = DestWB.Worksheets("Sheet1")

* * Lr = LastRow(DestSh)
* * Set DestRange = DestSh.Range("A" & Lr + 1)

* * 'We make DestRange the same size as SourceRange and use the Value
* * 'property to give DestRange the same values
* * With SourceRange
* * * * Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count)
* * End With
* * DestRange.Value = SourceRange.Value

* * DestWB.Close savechanges:=True

* * With Application
* * * * .ScreenUpdating = True
* * * * .EnableEvents = True
* * End With

End Sub

Function LastRow(sh As Worksheet)
* * On Error Resume Next
* * LastRow = sh.Cells.Find(What:="*", _
* * * * * * * * * * * * * * After:=sh.Range("A1"), _
* * * * * * * * * * * * * * Lookat:=xlPart, _
* * * * * * * * * * * * * * LookIn:=xlFormulas, _
* * * * * * * * * * * * * * SearchOrder:=xlByRows, _
* * * * * * * * * * * * * * SearchDirection:=xlPrevious, _
* * * * * * * * * * * * * * MatchCase:=False).Row
* * On Error GoTo 0
End Function

Function LastCol(sh As Worksheet)
* * On Error Resume Next
* * LastCol = sh.Cells.Find(What:="*", _
* * * * * * * * * * * * * * After:=sh.Range("A1"), _
* * * * * * * * * * * * * * Lookat:=xlPart, _
* * * * * * * * * * * * * * LookIn:=xlFormulas, _
* * * * * * * * * * * * * * SearchOrder:=xlByColumns, _
* * * * * * * * * * * * * * SearchDirection:=xlPrevious, _
* * * * * * * * * * * * * * MatchCase:=False).Column
* * On Error GoTo 0
End Function

Function bIsBookOpen_RB(ByRef szBookName As String) As Boolean
' Rob Bovey
* * On Error Resume Next
* * bIsBookOpen_RB = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

-----



Koen

Need some help with this code:
 
"Ed from AZ" wrote:

As far as altering the source worksheet, why not copy the source rnage
into the backup file and THEN do all the manipulations? Or can you
simply close the source book without saving changes?


I'm not sure I understand, but I'd like to execute the code on the
sourcedata file, because this file is used over and over again.
Also, I don't want to have to open the backup file (the purpose is that my
colleagues can also execute this). Other problem is that the name of the
sourcefile is altered every 2 to 3 days.

And actually I can't really program, so I don't really know what every
function is used for.





All times are GMT +1. The time now is 08:20 AM.

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