QUESTION: I havesheet for vlidating external source(design software data)data,i have refresh button on mysheet which is refreshing thesheet when ever any changes occures in external source, now i want to copy this(sheet1) data into new sheet code itself creates new sheet is much better ,simulataniously changed data(external source) should be replaced in sheet1,these two events happens when i click refresh button
ANSWER: Could you please clarify your question a bit for me?
Do you mean that when you click the refresh button you want sheet1 to be copied--before any changes are made to it--so that you always have a history of sheet1 before each refresh?
I assume you already have code that refreshes sheet1 from the external source. Is this correct?
So you just want code to add to the refresh button to copy sheet1, rename it appropriately ("sheet1-001", "sheet1-002", etc.)?
---------- FOLLOW-UP ----------
QUESTION: Thanks for followup,your understand my requiremnt absolute correct,i just need that.This is my refresh button code
Temp = AddNetName_To_List()
End Sub Private Sub CommandButton1_Click() Dim strNetName As String FullFileName = ActiveWorkbook.Path & "\" & "NetName.txt" Set objReport = New Report If SimulationMode.Value = False Then If Len(Dir(FullFileName)) > 0 Then
Kill (FullFileName)
End If strTemp = "cmd /c extracta " & Chr(34) & txtFilePath.Text & Chr(34) & " " & Chr(34) & ActiveWorkbook.Path & "\" & "CommandTemplate.txt" & Chr(34) & " " & Chr(34) & ActiveWorkbook.Path & "\" & "NetName.txt" & Chr(34) Temp = Shell(strTemp, vbHide) Application.Wait DateAdd("s", 5, Now) End If strFileContent = objReport.GetReport(ActiveWorkbook.Path & "\" & "NetName.txt") myArray = Split(strFileContent, vbCrLf) myArrayLength = UBound(myArray) - LBound(myArray) + 1 strTemp = "" ExcelRow = 10
For i = 0 To myArrayLength - 1 Step 1 If myArray(i) <> "" And Mid(myArray(i), 1, 2) = "S!" Then strNetName = Split(myArray(i), "!")(1) If (Split(myArray(i), "!")(1) <> "" And Split(myArray(i), "!")(1) = Bus_Name) Or (Split(myArray(i), "!")(1) = "") Then Range("B" & ExcelRow) = Split(myArray(i), "!")(2) Range("C" & ExcelRow) = Split(myArray(i), "!")(3)
If CDec(Split(myArray(i), "!")(3)) < MinLength Or CDec(Split(myArray(i), "!")(3)) > MaxLength Then
Range("B" & ExcelRow).Font.Color = vbRed Range("E" & ExcelRow).Font.Color = vbBlue Range("G" & ExcelRow).Font.Color = vbBlue Range("E" & ExcelRow) = CStr(CDec(Split(myArray(i), "!")(3)) - MinLength) Range("G" & ExcelRow) = CStr(MaxLength - CDec(Split(myArray(i), "!")(3))) Else Range("B" & ExcelRow).Font.Color = vbBlack Range("E" & ExcelRow).Font.Color = vbBlack Range("G" & ExcelRow).Font.Color = vbBlack Range("E" & ExcelRow) = CStr(CDec(Split(myArray(i), "!")(3)) - MinLength) Range("G" & ExcelRow) = CStr(MaxLength - CDec(Split(myArray(i), "!")(3))) End If ExcelRow = ExcelRow + 1 End If End If Next i
Okay, here is some code that should do what you want.
First, add this function code either to the code module containing the button code, or to a standard macro module in your workbook:
Function SheetExists(SheetName As String) As Boolean
'returns TRUE if named sheet exists, else FALSE Dim Sh As Object On Error GoTo NoSheet Set Sh = Sheets(SheetName) SheetExists = True Exit Function
NoSheet:
SheetExists = False
End Function
Then you can add this code to your existing button code--near the top of the CommandButton1_Click procedure--must be before the code makes any changes to Sheet1.
Dim Sindex As Integer Dim NewName As String 'Find next available sheet index Sindex = 1 NewName = "Sheet1-001" Do While SheetExists(NewName) Sindex = Sindex + 1 NewName = "Sheet1-" & Format(Sindex, "000") Loop 'copy and rename sheet Sheet1.Copy after:=Sheet1 ActiveSheet.Name = NewName 'reactivate sheet1 Sheet1.Activate
Note that the added sheets will be placed in tab order after Sheet1 from newest to oldest.
Also note that you could wrap a Sub..End Sub around this code to turn it into a macro, and call it from within the CommandButton1_Click procedure rather than pasting the code in-line.
Feel free to follow up if any questions or problems.
Advertisement