Posts by Obelix

Re: Using the .Replace funktion on hidden cells.

I have also tried this code

Sub Makro_Replace()
    Columns("K:K").Replace What:=");;", Replacement:="="""");;", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub

It did not work.
I have tried on a sheet with no rows or columns hidden and it still do not work.

It does work when I do it manual.
I am trying to change this formula
=OM(ELLER(Försäljning!$C$7="";$C$7);;C28*$C$7/Försäljning!$C$7)
to this
=OM(ELLER(Försäljning!$C$7="";$C$7="");;C28*$C$7/Försäljning!$C$7).
There are approximately 58 formulas and each differense a little (the row no after C).

Hello,

I want to replace a part of a formula in hidden columns and cells but I don't know which rows are hidden and they have to be remained hidden after the replacement and those rows that aren't hidden must remain unhidden after the replacement.

I tried this code but it dosen't work on hidden cells:

Sub Makro_Replace()
    Columns("K:K").SpecialCells(xlCellTypeFormulas, 23).Replace What:=");;", Replacement:="="""");;", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub

Best regards. Obelix

I have a userform with a close button.
When a user clicks this button the userform is unloaded and the workbook is closed without saving.
What I want it to do also is quit Excel if the user doesn't have no other workbooks open.

Setting the Public Statement does not work.
These are my codes:

Option Explicit
Public Ankis_makro As Boolean


Sub Makro2_Ankis_veckor()
On Error Resume Next
Application.ScreenUpdating = False
    Sheets("Listan").Activate
    Selection.AutoFilter Field:=1
    Selection.AutoFilter Field:=2
    Selection.AutoFilter Field:=3
    Selection.AutoFilter Field:=4
    Selection.AutoFilter Field:=5
    Selection.AutoFilter Field:=6
    Selection.AutoFilter Field:=7
    Selection.AutoFilter Field:=8
    Selection.AutoFilter Field:=9
    Range(Range("J2"), Range("I65536").End(xlUp).Offset(0, 1)).FormulaR1C1 = "=TEXT(RC[-9],""ÅÅÅÅ"")"
    Range(Range("J2"), Range("J65536").End(xlUp)) = Range(Range("J2"), Range("J65536").End(xlUp)).Value
    Range(Range("K2"), Range("J65536").End(xlUp).Offset(0, 1)).FormulaR1C1 = "=INT((RC[-10]-(DATE(YEAR(RC[-10]+(MOD(8-WEEKDAY(RC[-10]),7)-3)),1,1))-3+MOD(WEEKDAY(DATE(YEAR(RC[-10]+(MOD(8-WEEKDAY(RC[-10]),7)-3)),1,1))+1,7))/7)+1"
    Range(Range("K2"), Range("K65536").End(xlUp)) = Range(Range("K2"), Range("K65536").End(xlUp)).Value
    Range(Range("A2"), Range("A65536").End(xlUp)).FormulaR1C1 = "=RC[9]&"" V.""&RC[10]"
    Range(Range("A2"), Range("A65536").End(xlUp)) = Range(Range("A2"), Range("A65536").End(xlUp)).Value
    Columns("J:K").ClearContents
    Sheets("P.Diagram").Activate
    ActiveChart.PivotLayout.PivotTable.RefreshTable
    Sheets("Listan").Activate
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
    Set VBProj = ActiveWorkbook.VBProject
    Set VBComp = VBProj.VBComponents("ThisWorkbook")
    Set CodeMod = VBComp.CodeModule
    With CodeMod
        LineNum = .CreateEventProc("BeforeSave", "Workbook")
        LineNum = LineNum + 1
        .InsertLines LineNum, _
        "    If SaveAsUI = True Then Cancel = True" & _
        Chr(13) & _
        "    Cancel = True" & _
        Chr(13) & _
        "    If SaveAsUI Then SaveAsUI = False" & _
        Chr(13) & _
        "    Msgbox ""Saving has been disabled!"" "
    End With
    Set VBProj = Nothing
    Set VBComp = Nothing
    Set CodeMod = Nothing
Application.ScreenUpdating = True
    Ankis_makro = True
End Sub

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
    If Ankis_makro = True Then
        Me.Saved = True
        Exit Sub
    End If
    Select Case MsgBox("Do you want to save the changes?", vbYesNo + vbQuestion + vbDefaultButton2 + vbSystemModal + vbMsgBoxSetForeground)
        Case vbNo
            Me.Saved = True
            Exit Sub
    End Select
Application.ScreenUpdating = False
    Sheets("P.Diagram").Activate
    ActiveChart.PivotLayout.PivotTable.RefreshTable
    Sheets("Listan").Activate
    Selection.AutoFilter Field:=1
    Selection.AutoFilter Field:=2
    Selection.AutoFilter Field:=3
    Selection.AutoFilter Field:=4
    Selection.AutoFilter Field:=5
    Selection.AutoFilter Field:=6
    Selection.AutoFilter Field:=7
    Selection.AutoFilter Field:=8
    Selection.AutoFilter Field:=9
    Range("A65536").End(xlUp).Offset(1, 0).Select
    ActiveWorkbook.Save
    Me.Saved = True
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_Open()
    Ankis_makro = False
End Sub

What ever I do I can't get the Ankis_makro set to True.
Anyone got an solution for me?

/Obelix

Hello
I'm amtepting to populate some labels from some predefined strings based on the scrollbar value.

I have these codes:

Option Explicit
Public Meddelande1 As String, Meddelande2 As String, Meddelande3 As String, Meddelande4 As String, Meddelande5 As String, Meddelande6 As String, Meddelande7 As String, Meddelande8 As String, Meddelande9 As String

Private Sub UserForm_Initialize()
On Error Resume Next
    Workbooks("Kontrollsystemet.xls").Close SaveChanges:=False
Application.ScreenUpdating = False
    Workbooks.Open "V:\alla\Beredning\Kontrollsystemet\Kontrollsystemet.xls", ReadOnly:=True
    Sheets("Meddelanden").Activate
    Meddelande1 = Range("B2").Text
    Meddelande2 = Range("B3").Text
    Meddelande3 = Range("B4").Text
    Meddelande4 = Range("B5").Text
    Meddelande5 = Range("B6").Text
    Meddelande6 = Range("B7").Text
    Meddelande7 = Range("B8").Text
    Meddelande8 = Range("B9").Text
    Meddelande9 = Range("B10").Text
    Workbooks("Kontrollsystemet.xls").Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub

Private Sub ScrollBar1_Change()
On Error Resume Next
Dim i As Long, j As Long, k As Long
    i = ScrollBar1.Value
    j = i + 1
    k = i + 2
        Label1 = Meddelande & i
        Label2 = Meddelande & j
        Label3 = Meddelande & k
    i = vbNull
    j = vbNull
    k = vbNull
End Sub

I'm trying to make 3 labels content scrollable.

Thanx
/Obelix

Re: Force Focus On Textbox

Changing tab order didn't do anything.

However having TextBox1.SetFocus only in UserForm_Initialize didn't work,
having TextBox1.SetFocus in UserForm_Initialize AND in UserForm_Activate didn't work,
but having TextBox1.SetFocus only in UserForm_Activate did work.

Thanx!

/Obelix

Re: Force Focus On Textbox

Quote from Andy Pope

No obvious reason then why .Setfocus should not work,

Can you post example workbook?

http://www.driveway.com/e9j5h2d4i1

or here http://file.io/file/iynigu.xls

Re: Force Focus On Textbox

I have 1 textbox and a few labels and 3 commandbuttons.
Noone is locked.
When I tab the first commandbutton gets the focus and if I instead do a shift tab the textbox gets the focus.
Only the textbox and all the commandbuttons have tabstop enabled.
None have autotab on.
I don't have the SetFocus on anything else and I can't see anything else that might function as a setfocus.

Hello all

I have tried many variations with the SetFocus but I still can not get it to work?

I have tried these three variations:

[I]UserForm1.TextBox1.SetFocus
Me.TextBox1.SetFocus
TextBox1.SetFocus[/I]

I have tried those in various places like:

[I]UserForm_Initialize
UserForm_Activate[/I]

I have also tried changing the tab order:
0
1

"Inside" and "outside" of:

[I]Application.ScreenUpdating = False
Application.ScreenUpdating = True[/I]

I don't know what more to try to get TextBox1 focus on start of the userform.

Kindest Regards
/Obelix

Hello all

I have a userform that opens a woorkbook and fills some textbox from that woorkbook.
Although that it goes very fast it is still visible (sometime just in the toolbar) and flickers the screen. Is it possible to open it "hidden"?

This is how my code looks like:

Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
    On Error Resume Next
    Workbooks("Kontrollsystemet.xls").Close SaveChanges:=False
    Workbooks.Open "V:\alla\Beredning\Kontrollsystemet\Kontrollsystemet.xls", ReadOnly:=True
    Sheets("Calc").Activate
    Label4 = Range("K7")
    Label5 = Range("L7")
    Workbooks("Kontrollsystemet.xls").Close SaveChanges:=False
    Caption = Now
    TextBox1.SetFocus
Application.ScreenUpdating = True
End Sub

Regards
/Obelix

Re: Change Colour On Autofilter Drop-down Arrows

Nothing happens when I hover?

/O

EDIT: Ooops, sry. Thought you meant the hover the drop-down buttons.

/O

Hi

Is it possible to change those AutoFilter drop-down arrows that are active? As it is now they are hard to spot which is in use.

Best Regards
/Obelix

Hello all!

I'm not good at all with IF codes (also not my english isn't good).
I want help with "cleaning" my current IF code (if possible).
I tried to se if I could use/learn the examples here http://www.ozgrid.com/VBA/SpeedingUpVBACode.htm but it was to hard for me.
This is my code (it's a part of a larger code):

Sub test()
    If Range("B1") = "-20" Then
    Else
        Columns("B:C").Insert Shift:=xlToRight
        Range("B1") = "-20"
        Range("B2") = "Pk"
    End If
    If Range("D1") = "-15" Then
    Else
        Columns("D:E").Insert Shift:=xlToRight
        Range("D1") = "-15"
        Range("D2") = "Pk"
    End If
    If Range("F1") = "-10" Then
    Else
        Columns("F:G").Insert Shift:=xlToRight
        Range("F1") = "-10"
        Range("F2") = "Pk"
    End If
    If Range("H1") = "-5" Then
    Else
        Columns("H:I").Insert Shift:=xlToRight
        Range("H1") = "-5"
        Range("H2") = "Pk"
    End If
    If Range("J1") = "-3" Then
    Else
        Columns("J:K").Insert Shift:=xlToRight
        Range("J1") = "-3"
        Range("J2") = "Pk"
    End If
    If Range("L1") = "-2" Then
    Else
        Columns("L:M").Insert Shift:=xlToRight
        Range("L1") = "-2"
        Range("L2") = "Pk"
    End If
    If Range("N1") = "-1" Then
    Else
        Columns("N:O").Insert Shift:=xlToRight
        Range("N1") = "-1"
        Range("N2") = "Pk"
    End If
    If Range("P1") = "0" Then
    Else
        Columns("P:Q").Insert Shift:=xlToRight
        Range("P1") = "0"
        Range("P2") = "Pk"
    End If
    If Range("R1") = "1" Then
    Else
        Columns("R:S").Insert Shift:=xlToRight
        Range("R1") = "1"
        Range("R2") = "Pk"
    End If
    If Range("T1") = "2" Then
    Else
        Columns("T:U").Insert Shift:=xlToRight
        Range("T1") = "2"
        Range("B2") = "Pk"
    End If
    If Range("V1") = "3" Then
    Else
        Columns("V:W").Insert Shift:=xlToRight
        Range("V1") = "3"
        Range("V2") = "Pk"
    End If
    If Range("X1") = "5" Then
    Else
        Columns("X:Y").Insert Shift:=xlToRight
        Range("X1") = "5"
        Range("X2") = "Pk"
    End If
    If Range("Z1") = "10" Then
    Else
        Columns("Z:AA").Insert Shift:=xlToRight
        Range("Z1") = "10"
        Range("Z2") = "Pk"
    End If
    If Range("AB1") = "15" Then
    Else
        Columns("AB:AC").Insert Shift:=xlToRight
        Range("AB1") = "15"
        Range("AB2") = "Pk"
    End If
    If Range("AD1") = "20" Then
    Else
        Columns("AD:AE").Insert Shift:=xlToRight
        Range("AD1") = "20"
        Range("AD2") = "Pk"
    End If
End Sub

Thanx!
/Obelix

Re: Adding New Cells Without Affecting Formulas In Nearby Kolumns And Copy The Contents

Quote from thomach

P.S. If you want to add data to only the cell in columns A:D and want the added cells to have the VALUE of the cell above it, rather than a formula refering the cell above it, then here is an alternative.

Code

Sub AddRows()
Dim r  As Long, LastRow As Long, c As Range


    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For r = LastRow To 2 Step -1
        Rows(r).Insert Shift:=xlDown
    Next r
    
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    Range(Cells(2, 1), Cells(LastRow, 4)).Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[-1]C"


    For Each c In Selection
        c = c.Value
    Next c


End Sub

Display More

It somewhat worked. First problem is that it inserted rows, which made gaps in my formulas that I have in the other columns. Can it use insert cells instead of insert rows? Not sure thout that "insert" won't screw with my ormulas, but it's worth a try first.
Second is the the range A1:D100 I used in my questions was just an exampel. I don't have my file here at the moment så I can't look up what the real range is, but can't it be made using a selection instead?

Thanx!
/Obelix

Re: Adding New Cells Without Affecting Formulas In Nearby Kolumns And Copy The Contents

Quote from Dave Hawley

To fill a table with blank rows with data from above do this.

1) Select the table range and go to Edit>Go to - Special - Blanks - OK

2) Type = then hold down Ctrl and push the Up Arrow.

3) Finally, with Ctrl still help, push Enter

Display More

Doing it this way didn't add any new cells for me?

Hello!

I have a list that I want every second row to be "moved" and then in the empty ones copied from the above ones.
exampel: the current list is in A1:D100.
I want it to be A1:D200 and A2:D2 is a copy of A1:D1; A4:D4 is a copy of A3:D3 etc etc
I also have a list in E1:H500 that all have formulas that calculates with the values in A:D
The new rows in A:D may not affect the formulas.
if a formula in E2 calculates the value in A2, the new cells may not affect the formula so it instead calculates A3!
I can not change the formulas.

Sorry for my english, I'm a swede...
and sorry if this questions was already asked. I tried searching and didn't find anythnig. My searching skill is realy bad.

Thanx
/Obelix

Hello,

I'm trying to figure out how to write a formula that gets the value in a cell that is in another sheet and part of the sheets name is in another cell in another sheet.

This exampel gets the contents of cell Q1 in the sheet named "W23 2006" ='W23 2006'!Q1
What I am looking for is that the formula gets the week number (in the exampel "23") from another cell in sheet "W24 2006".
An exampel of what I was trying to do: ='W&R1& 2006'!Q1 (but it dosen't work)

What is an solution?

Thanx!
/Obelix

Re: Userform, labels equals range in workbok, easier code

Quote from Quoth

Hi Obelix,

Here is quick solution I drew up - no doubt someone will have a more elegant solution but this should do the job.

(This was based on a sheet with two rows and two columns and assumes that all the labels have already been correctly named on the form)

Code

Private Sub CommandButton1_Click()


Dim LabelName, ColumnLetter As String


For i = 1 To 2 'Loop to cycle through number of rows
    For j = 1 To 2 'Loop to cycle through number of columns
        
        Select Case j 'Case Statement to assign letter to Column Number
            Case 1
                ColumnLetter = "A"
            Case 2
                ColumnLetter = "B"
        End Select
        
        LabelName = "label" & ColumnLetter & i 'Set labelname
               
        UserForm1.Controls(LabelName) = ActiveSheet.Cells(i, j)
        
    Next j
Next i


End Sub

Display More

Regards,

Q

Display More

Thanx!
I haven't testet it yet, due to that I haven't created the labels yet.
I thought I would rename each label to a "smart" name, but renaming 600 labels isn't fun.
So instead of renaming a label from Label1 to LabelA1 I'm keeping the original name, Label1.
So how would the code look like for this purpose?
The labes 1 to 60 is cells A1 to A60 and labels 61 to 120 is cells B1 to B60, etc.

/Obelix

Re: Userform, labels equals range in workbok, easier code

Quote from Badger101

My solution would to be to rethink what you are doing. I'm just not convinced that you would ever want 500 labels on a userform. Have you actually created all these or are you doing it on the fly?

I have 60 rows and 10 columns that I want to display somehow and a userform is the most convenient for the users.
You mean that is simply to many labels?

/Obelix

Hello!

I have over 500 labels in a userform and each labels content is gathered from an workbok like this:

Private Sub UserForm_Initialize()
    CommandButton3.SetFocus
Application.ScreenUpdating = False
    Workbooks.Open "V:\alla\Beredning\Semesterstänging Medleverantörer och Verkstäder.xls"
    Sheets("2006").Select
'    Sheets(Year(TODAY())).Select
    LabelA1 = Range("A1")
...
    LabelA60 = Range("A60")
    LabelB1 = Range("B1")
...
    LabelB60 = Range("B60")
    LabelC1 = Range("C1")
...
    LabelC60 = Range("C60")
...
    ActiveWorkbook.Close SaveChanges:=False
Application.ScreenUpdating = True
End Sub

I have shortened the code and I haven't yet written all labes.
The ... is supposed to mean "from" and "to".
I don't want to write over 500 lines of the label codes.
So what is an easier way to write it?

Thanx!
/Obelix