Posts by James125


I'm making a summary workbook. Each worksheet name represents a workbook. I want to then set the workbook I have just opened as 'refbk', though I am having trouble.

I often have a problem with the vbaProject.bin file corrupting and not allowing me to open that excel workbook. Here is my solution that has worked a few times;
 Rename the file extension to .xls
 On the developer tab disable all macros
 With excel closed Hold Ctrl, doubleclick to open the bad workbook in safemode
 Hopefully it opens
 View the VBA code and remove and export it all
 Save the bad file with your preferred extension
 Reopen the file, import the VBA modules and save
 Reopen and enable macros
 Try to back things up properly in future

Hello
I have had a lot of corrupted vbaProject.bin files. I tends to happen to one particular work book. Is there something in the code that causes it to corrupt itself?
No Corruption vbaProject.bin = 81KB
With Corruption vbaProject.bin = 57KBCode
Display MoreSub lookup_macro() Dim ActSheet As Worksheet Dim SelRange As Range Set ActSheet = ActiveSheet Set SelRange = Selection Dim LookupBk As Workbook Set LookupBk = ActiveWorkbook Dim CurrSheet As Worksheet ActSheet.Select SelRange.Select ReDim WrkBks(1 To SelRange.Count) ReDim Row2Fill(1 To SelRange.Count) 'Cols_to_lookup = Cells(1, Columns.Count).End(xlToLeft).Column  2 'Cols_to_lookup = Range("A1").Columns.Count  2 For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column If Cells(1, i).Value = "END" Then Cols_to_lookup = i  3 Next i For i = 1 To SelRange.Count 'loops each row ie each book WrkBks(i) = SelRange.Item(i) Row2Fill(i) = SelRange.Cells(i).Row P253_Open (WrkBks(i)) 'OPEN OPEN OPEN======================================================== Set CurrWbk = Workbooks(WrkBks(i) & ".xlsb") 'Row, column For j = 1 To Cols_to_lookup 'loops through columns left to right If ActSheet.Cells(1, j + 2).Value = "skip" Then GoTo skip Set CurrSheet = CurrWbk.Sheets(ActSheet.Cells(1, j + 2).Value) 'omitted LookupBk. TheFunction = ActSheet.Cells(6, j + 2).Value With CurrSheet NumCols = .Cells(1, Columns.Count).End(xlToLeft).Column For k = 3 To .UsedRange.Rows.Count If .Cells(k, 1).Value >= ActSheet.Cells(4, j + 2).Value And .Cells(k  1, 1).Value < ActSheet.Cells(4, j + 2).Value Then StartRow = k If .Cells(k, 1).Value >= ActSheet.Cells(5, j + 2).Value And .Cells(k  1, 1).Value < ActSheet.Cells(5, j + 2).Value Then EndRow = k Next k For k = 3 To .UsedRange.Columns.Count If .Cells(1, k).Value = ActSheet.Cells(2, j + 2).Value Then HeaderCol = k If .Cells(1, k).Value = ActSheet.Cells(3, j + 2).Value Then HeaderCol2 = k Next k On Error GoTo ErrorHandle Select Case TheFunction Case "Value" Value2Paste = .Cells(StartRow, HeaderCol).Value Case "Difference" Value2Paste = .Cells(EndRow, HeaderCol).Value  .Cells(StartRow, HeaderCol).Value Case "Max" Value2Paste = WorksheetFunction.Max(.Range(.Cells(EndRow, HeaderCol), .Cells(StartRow, HeaderCol))) Case "Min" Value2Paste = WorksheetFunction.Min(.Range(.Cells(EndRow, HeaderCol), .Cells(StartRow, HeaderCol))) Case "Average" Value2Paste = WorksheetFunction.Average(.Range(.Cells(EndRow, HeaderCol), .Cells(StartRow, HeaderCol))) Case "UrbanSum" Value2Paste = 0 For m = StartRow To EndRow If .Cells(m, HeaderCol2) < (60 / 3.6) Then Value2Paste = Value2Paste + .Cells(m, HeaderCol) * (.Cells(m, 1)  .Cells(m  1, 1)) End If Next m Case "RuralSum" Value2Paste = 0 For m = StartRow To EndRow If .Cells(m, HeaderCol2) < (90 / 3.6) And .Cells(m, HeaderCol2) >= (60 / 3.6) Then Value2Paste = Value2Paste + .Cells(m, HeaderCol) * (.Cells(m, 1)  .Cells(m  1, 1)) End If Next m Case "MotorwaySum" Value2Paste = 0 For m = StartRow To EndRow If .Cells(m, HeaderCol2) >= (90 / 3.6) Then Value2Paste = Value2Paste + .Cells(m, HeaderCol) * (.Cells(m, 1)  .Cells(m  1, 1)) End If Next m End Select End With ActSheet.Cells(Row2Fill(i), j + 2).Value = Value2Paste skip: Next j 'CurrWbk.Close savechanges:=False 'CLOSE CLOSE CLOSE ============================================ Next i 'WrkBks (i) Exit Sub ErrorHandle: Value2Paste = "Error!" Resume Next End Sub

I have some data like this; 1000 1000 10 10 100 1111
each number represents a second. I want to convert it to a percentage ie;25 25 25 25 25 25 25 25 50 50 50 50 33 33 33 100 100 100 100
Any idea how to do it in excel for a lot of data?

I have a workbook with a chartsheet on it. It has two series, one from workbook A and one from workbook B. If I delete the series from workbook B, the chart book should update it's links to show that only workbook A is linked. However if I update it still shows both books as linked. I tried running;
but all I get is runtime error 1004
Method 'UpdateLink' of object'_Workbook' failedI have also tried to go Data, Connections tab, Edit links, Update links. But the link to workbook B remains.
It seems the only way I can update the links is to save and reopen the workbook. Does anyone know how to update the links without having to do this?

I think I just have to ReDim later no alternative. Just a bit more code to write not too bad

Currently I have one massive module with 800 lines of code & I want to seperate it into seperate manageable chunks. First step is to get data from the inputs sheet. I'm trying to make the variables public so they can be used in other modules.
[VBA]
Option Explicit
Public FD_Ratio As Double
Public gears As Double
Public TM As Double
Public Wheel_Diameter As Double
Public F0 As Double
Public F1 As Double
Public F2 As Double
Public Kr As Double
Public SM As Double
Public PI As Double
With ThisWorkbook.Sheets("Inputs")
gears = .Cells(9, Columns.Count).End(xlToLeft).Column  10
End WithPublic Gear_ratios(gears) As Double[/VBA]
The problem here is the length of some variables ie Gear_ratios is defined by variables on the sheet. How can I get around this?

Thanks BaraaKhalil this is what I wanted.
Norei, I don't want them formatted as 'true' dates because they tend to be more difficult to plot into a chart. With a fraction I am free to change to hours or minutes etc and plot more easily.

I have a spreadsheet full of times formatted as 13.09.2017 10:31:35 DD.MM.YYYY HH:MM:SS
I want to change them to a Number which should be 42991.438599537 in this example.
This is my attempted code;Code
Display MoreSub ChangeDateTimetoNumber() 'cells(1,1)= 13.09.2017 10:31:35 DD.MM.YYYY HH:MM:SS MyDateTime = Cells(1, 1) MyDateTime = Replace(MyDateTime, ".", "/") 'Run time error Type 13 Type mismatch myDateTimeNumber = CDbl("#" & MyDateTime & "#") 'This works but VBA automatically changes the format between the ## myDateTimeNumber = CDbl(#9/13/2017 10:31:35 AM#) End Sub

Hello
I have a whole workbook of charts with series references such as;
=SERIES([o040914c.xls]csv!$GD$1,[o040914c.xls]csv!$A$2:$A$18103,[o040914c.xls]csv!$GD$2:$GD$18103,4)
sometimes I want to be able to make changes to multiple charts and series, for example replacing the workbook reference with another one.
Eg [o040914c.xls] to [o130814a.xls] (British date format)
Also the excel I am using is 2003.

Re: How to use a constant from the WorksheetFunction.Max?
OK royUK I have declared test_leng as long but still get the same error;
Compile Error:
Constant expression required.CodeSub Make_a_dyno_file() Const test_leng As Long = WorksheetFunction.Max(ThisWorkbook.Sheets("Vehicle Data").Range("F:F")) '=886 in this case Dim Velocity(0 To test_leng) End Sub
I then tried using Dim instead of Const, but I got the equals highlighted and the following error;
Compile Error:
Expected: end of statement 
Hello all. I am getting an error with this code, the test_leng is a constant of 886, yet I can't declare it as a constant either.
Compile Error:
Constant expression required. 
I want to colour my combobox items with respect to the colour of the seriescollection that they represent. However I get this error;
Compile Error
Invalid qualifierand then 'Color' highlighted;
this.Items.Add (Color.Red)Code
Display MorePrivate Sub UserForm_Initialize() series_plotted = ActiveChart.SeriesCollection.Count ReDim the_string(1 To series_plotted) ReDim the_series_names(1 To series_plotted) ReDim the_series_Formula(1 To series_plotted) ReDim the_column_letter_loc(1 To series_plotted) ReDim the_column_letter(1 To series_plotted) ReDim the_testid_loc(1 To series_plotted) ReDim the_testid(1 To series_plotted) For i = 1 To series_plotted the_series_names(i) = ActiveChart.SeriesCollection(i).Name the_series_Formula(i) = ActiveChart.SeriesCollection(i).Formula the_column_letter_loc(i) = InStr(1, the_series_Formula(i), "$") + 1 the_column_letter(i) = Right(Left(the_series_Formula(i), the_column_letter_loc(i) + 1), 2) the_testid_loc(i) = InStr(1, the_series_Formula(i), "[") + 1 the_testid(i) = Right(Left(the_series_Formula(i), the_testid_loc(i) + 7), 8) '9 was 12 'Debug.Print the_series_names(i) 'Debug.Print the_series_Formula(i) 'Debug.Print the_testid(i) 'the_string(i)= Next i With ComboBox1 .Clear For i = 1 To series_plotted .AddItem the_testid(i) & " " & the_series_names(i) & " " & i this.Items.Add (Color.Red) Next i End With End Sub

Re: Read the series formula into VBA.
so far I have;
CodePrivate Sub CommandButton1_Click() the_series_Formula = ActiveChart.SeriesCollection(2).Formula Debug.Print the_series_Formula the_column_letter_loc = InStr(1, the_series_Formula, "$") + 1 Debug.Print the_column_letter_loc the_column_letter = Right(Left(the_series_Formula, the_column_letter_loc), 1) Debug.Print the_column_letter End Sub
The problem is it only gives me the letter of the 1st series of data not the 2nd. Why is this?

I have 2 series of data on a excel line graph. One of which is;
=SERIES(Sheet1!$G$1,Sheet1!$E$2:$E$12615,Sheet1!$G$2:$G$12615,2)I want to be able to produce a macro that can read this series formula. So that I can then find which column the Yaxis variable come from. In this case 'G'.
thank you

I want to be able to right click on a chart series and then have the option in the drop down menu of running my own macro. (excel 2003)
Many thanks

Solved!!
Solved it! Hopefully someone else will find this handy!
Code
Display MoreSub formula_read() The_formula = Cells(2, 88).formula '=AD203(BC2*(1(1/BB2))) Length = Len(The_formula) number_count = 0 For i = 1 To Length If Mid(The_formula, i, 1) >= "0" And Mid(The_formula, i, 1) <= "9" Then GoTo is_a_number GoTo not_a_number is_a_number: the_number = the_number & Mid(The_formula, i, 1) number_count = number_count + 1 GoTo loop_again not_a_number: If number_count = 0 Then NON_number_count = i If number_count > 0 Then i = Length loop_again: Next i the_number = the_number + 1 final_string = Mid(The_formula, 1, NON_number_count) & the_number & Mid(The_formula, number_count + NON_number_count + 1, Length  number_count) Debug.Print NON_number_count 'the length of nonnumbers Debug.Print number_count 'the length of numbers Debug.Print the_number 'ie 204 Debug.Print The_formula 'original formula Debug.Print final_string 'new formula End Sub

I want to read the formula from a cell, ie =AD203(BC2*(1(1/BB2))), specifically the '203' so I can then modify it and then replace it with another number. The number may be 1to3 digits long and may be proceeded by letters and signs brackets etc. My first task is to see how long the number is and record it as count, however my code doesn't appear to work.
Code
Display MoreSub formula_read() The_formula = Cells(2, 82).formula '=AD203(BC2*(1(1/BB2))) Length = Len(The_formula) Count = 0 For i = 1 To Length If Mid(The_formula, i, 1) = IsNum Then Count = Count + 1 If Count > 0 And Mid(The_formula, i, 1) <> IsNum Then i = Length Next i Debug.Print Count Debug.Print The_formula End Sub

Re: Say NO to would you like to reopen workbook prompt
I think this works...well it did but sometime it crashes excel instead
Code
Display MoreSub OpenTwoWorkboooks() On Error GoTo error_handling Workbooks("book1.xls").Activate GoTo its_open open1: Workbooks.Open ("book1.xls") its_open: On Error GoTo error_handling2 Workbooks("book2.xls").Activate GoTo its_open2 open2: Workbooks.Open ("book2.xls") its_open2: Exit Sub error_handling: Resume open1 error_handling2: Resume open2 End Sub
Thanks for your help everyone! :guitar: